[
  {
    "path": ".dockerignore",
    "content": ".git\n.stack-work\nclient/node_modules\nDockerfile\ndist-newstyle\n"
  },
  {
    "path": ".github/workflows/haskell.yaml",
    "content": "name: Haskell CI\n\non:\n  push:\n    branches: [ \"main\", \"ci\" ]\n  pull_request:\n    branches: [ \"main\" ]\n\npermissions:\n  contents: read\n\n\n\njobs:\n  build-cache:\n    runs-on: ubuntu-latest\n    container:\n      image: haskell:9.8.2\n    steps: \n      - uses: actions/checkout@v4\n\n      - name: Cache Cabal\n        id: cache-cabal\n        uses: actions/cache@v4\n        with:\n          path: |\n            /github/home/.cache\n            /github/home/.config\n            /github/home/.local\n          key: ${{ runner.os }}-${{ hashFiles('**/cabal.project') }}-${{ hashFiles('**/*.cabal') }}\n          # restore-keys: |\n          #   ${{ runner.os }}-\n\n      - name: Install dependencies\n        run: |\n          cabal update\n\n      - name: Build dependencies\n        run: |\n          cabal build --only-dependencies --enable-tests --enable-benchmarks\n\n      - name: Install skeletest-preprocessor\n        run: |\n          cabal install skeletest --installdir=$HOME/.local/bin --install-method=copy --overwrite-policy=always\n\n      - name: Check Cache\n        run: |\n          ls -ahl /github/home/\n          ls -ahl /github/home/.cache\n          ls -ahl /github/home/.config\n          ls -ahl /github/home/.local\n\n  build-982:\n    needs: build-cache\n    runs-on: ubuntu-latest\n    container:\n      image: haskell:9.8.2\n    steps: \n      - uses: actions/checkout@v4\n\n      - name: Cache Cabal Restore\n        id: cache-cabal-restore\n        uses: actions/cache@v4\n        with:\n          path: |\n            /github/home/.cache\n            /github/home/.config\n            /github/home/.local\n          key: ${{ runner.os }}-${{ hashFiles('**/cabal.project') }}-${{ hashFiles('**/*.cabal') }}\n          # restore-keys: |\n          #   ${{ runner.os }}-build-${{ env.cache-name }}-\n          #   ${{ runner.os }}-build-\n          #   ${{ runner.os }}-\n\n      - name: Check Cache\n        run: |\n          ls -ahl /github/home/\n          ls -ahl /github/home/.cache\n          ls -ahl /github/home/.config\n          ls -ahl /github/home/.local\n\n      - name: Source skeletest-preprocessor\n        run: |\n          echo \"$HOME/.local/bin\" >> $GITHUB_PATH\n\n      - name: Build\n        run: cabal build --enable-tests --enable-benchmarks all\n\n      - name: Test\n        run: cabal test\n\n  # build-966:\n  #   runs-on: ubuntu-latest\n  #   container:\n  #     image: haskell:9.6.6\n  #   steps: *cabal-test\n\n\n    # - uses: actions/setup-haskell@v1\n    #   with:\n    #     ghc-version: '9.6'\n    #     cabal-version: '3.2'\n\n    # - name: Cache\n    #   uses: actions/cache@v3\n    #   env:\n    #     cache-name: cache-cabal\n    #   with:\n    #     path: ~/.cabal\n    #     key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}\n    #     restore-keys: |\n    #       ${{ runner.os }}-build-${{ env.cache-name }}-\n    #       ${{ runner.os }}-build-\n    #       ${{ runner.os }}-\n"
  },
  {
    "path": ".github/workflows/packcheck.yaml",
    "content": "# packcheck-0.7.1\n# You can use any of the options supported by packcheck as environment\n# variables here.  See https://github.com/composewell/packcheck for all\n# options and their explanation.\n\nname: packcheck\n\n#-----------------------------------------------------------------------------\n# Events on which the build should be triggered\n#-----------------------------------------------------------------------------\n\non:\n  push:\n    branches: [ \"main\", \"ci\" ]\n  pull_request:\n\n\n#-----------------------------------------------------------------------------\n# Build matrix\n#-----------------------------------------------------------------------------\n\njobs:\n  build:\n    name: >-\n      ${{ matrix.name }}\n      ${{ matrix.command }}\n      ${{ matrix.runner }}\n      ${{ matrix.ghc_version }}\n    env:\n      # ------------------------------------------------------------------------\n      # Common options\n      # ------------------------------------------------------------------------\n      # GHC_OPTIONS: \"-Werror\"\n      CABAL_REINIT_CONFIG: y\n      LC_ALL: C.UTF-8\n\n      # ------------------------------------------------------------------------\n      # What to build\n      # ------------------------------------------------------------------------\n      # DISABLE_TEST: \"y\"\n      # DISABLE_BENCH: \"y\"\n      # DISABLE_DOCS: \"y\"\n      DISABLE_SDIST_BUILD: \"y\"\n      # DISABLE_SDIST_GIT_CHECK: \"y\"\n      # DISABLE_DIST_CHECKS: \"y\"\n\n      # ------------------------------------------------------------------------\n      # Selecting tool versions\n      # ------------------------------------------------------------------------\n      # For updating see: https://downloads.haskell.org/~ghcup/\n      GHCUP_VERSION: 0.1.40.0\n      GHCVER: ${{ matrix.ghc_version }}\n      GHCUP_GHC_OPTIONS: ${{ matrix.ghcup_ghc_options }}\n      # RESOLVER: ${{ matrix.stack_resolver }}\n\n      # ------------------------------------------------------------------------\n      # stack options\n      # ------------------------------------------------------------------------\n      # Note requiring a specific version of stack using STACKVER may fail due to\n      # github API limit while checking and upgrading/downgrading to the specific\n      # version.\n      # STACKVER: \"1.6.5\"\n      # STACK_UPGRADE: \"y\"\n      # STACK_YAML: \"stack.yaml\"\n\n      # ------------------------------------------------------------------------\n      # cabal options\n      # ------------------------------------------------------------------------\n      CABAL_CHECK_RELAX: y\n      CABAL_HACKAGE_MIRROR: \"hackage.haskell.org:http://hackage.fpcomplete.com\"\n      CABAL_PROJECT: ${{ matrix.cabal_project }}\n\n      # ------------------------------------------------------------------------\n      # Where to find the required tools\n      # ------------------------------------------------------------------------\n      PATH: /opt/ghc/bin:/sbin:/usr/sbin:/bin:/usr/bin\n      #TOOLS_DIR: /opt\n\n      # ------------------------------------------------------------------------\n      # Location of packcheck.sh (the shell script invoked to perform CI tests ).\n      # ------------------------------------------------------------------------\n      # You can either commit the packcheck.sh script at this path in your repo or\n      # you can use it by specifying the PACKCHECK_REPO_URL option below in which\n      # case it will be automatically copied from the packcheck repo to this path\n      # during CI tests. In any case it is finally invoked from this path.\n      PACKCHECK: \"./packcheck.sh\"\n      # If you have not committed packcheck.sh in your repo at PACKCHECK\n      # then it is automatically pulled from this URL.\n      PACKCHECK_GITHUB_URL: \"https://raw.githubusercontent.com/composewell/packcheck\"\n      PACKCHECK_GITHUB_COMMIT: \"2856fb3010c7d0549537852cfa8500b4f1b58537\"\n\n      # ------------------------------------------------------------------------\n      # Final build variables\n      # ------------------------------------------------------------------------\n      PACKCHECK_COMMAND: ${{ matrix.command }} ${{ matrix.pack_options }}\n\n    # ubuntu seems to have better support than debian on CI systems\n    runs-on: ${{ matrix.runner }}\n    strategy:\n      fail-fast: false\n      matrix:\n        include:\n\n          - name: ci\n            ghc_version: 9.12.1\n            command: cabal\n            runner: ubuntu-latest\n            cabal_project: cabal.project\n\n          - name: ci\n            ghc_version: 9.10.1\n            command: cabal\n            runner: macos-latest\n            cabal_project: cabal.project\n\n          - name: ci-sdist\n            ghc_version: 9.10.1\n            command: cabal\n            runner: ubuntu-latest\n            pack_options: >-\n              DISABLE_SDIST_BUILD=n\n\n          - name: ci\n            command: cabal\n            runner: ubuntu-latest\n            ghc_version: 9.8.4\n            cabal_project: cabal.project\n\n          - name: ci\n            ghc_version: 9.6.6\n            command: cabal\n            runner: macos-latest\n            cabal_project: cabal.project\n\n          # - name: ci\n          #   command: hlint\n          #   runner: ubuntu-latest\n          #   pack_options: >-\n          #     HLINT_VERSION=3.6.1\n          #     HLINT_OPTIONS=\"lint\"\n          #     HLINT_TARGETS=\"src test examples\"\n\n    steps:\n    - uses: actions/checkout@v2\n    - uses: actions/cache@v3\n      name: Cache common directories\n      with:\n        path: |\n          ~/.local\n          ~/.cabal\n          ~/.stack\n          ~/.ghcup\n        key: ${{ matrix.command }}-${{ matrix.ghc_version }}-${{ matrix.runner }}\n\n    - name: Download packcheck\n      run: |\n        if test ! -e \"$PACKCHECK\"\n        then\n          if test -z \"$PACKCHECK_GITHUB_COMMIT\"\n          then\n              die \"PACKCHECK_GITHUB_COMMIT is not specified.\"\n          fi\n          PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh\n          curl --fail -sL -o \"$PACKCHECK\" $PACKCHECK_URL || exit 1\n          chmod +x $PACKCHECK\n        elif test ! -x \"$PACKCHECK\"\n        then\n            chmod +x $PACKCHECK\n        fi\n\n    - name: Run packcheck\n      run: |\n        bash -c \"$PACKCHECK $PACKCHECK_COMMAND\"\n"
  },
  {
    "path": ".gitignore",
    "content": "dist-newstyle\n.DS_Store\ntags\nnode_modules\n# Auto-generated pre-commit config\n.pre-commit-config.yaml\n# Nix output dir\nresult\n.direnv\nclient/dist/hyperbole.js.LICENSE.txt\nSession.vim\n.cabal.nix\n/package.json\n/package-lock.json\n\n"
  },
  {
    "path": ".hlint.yaml",
    "content": "- arguments:\n    - -XOverloadedRecordDot\n\n- ignore: {name: \"Use <$>\"}\n- ignore: {name: \"Use newtype instead of data\"}\n\n# Hlint is not aware of OverloadedRecordDot\n# See https://github.com/ndmitchell/hlint/issues/1383\n- ignore: { name: Redundant id }\n"
  },
  {
    "path": ".packcheck.ignore",
    "content": "client/*.d.ts\nclient/src/\nclient/dist/*.d.ts\nclient/package-lock.json\nclient/webpack.config.js\nclient/package.json\nclient/tsconfig.json\ndocs/\ndemo/\n.dockerignore\n.github/workflows/haskell.yaml\n.github/workflows/packcheck.yaml\n.gitignore\n.hlint.yaml\n.packcheck.ignore\nDOCTODO.md\nDockerfile\nbin/dev\nbin/docgen\nbin/release\ncabal.project\nflake.lock\nflake.nix\nfourmolu.yaml\nhie.yaml\npackage.yaml\n"
  },
  {
    "path": "CHANGELOG.md",
    "content": "# Revision history for hyperbole\n\n## 0.6.0 -- 2026-01-15\n\nImprovements:\n* `ViewState` - built in threaded state, defaults to `()`, for folks who really miss Elm\n* `Concurrency` Controls - `Drop` vs `Replace` for overlapping updates\n* `pushUpdate` - server push an update to an arbitrary view\n* Long-running actions can be interrupted / cancelled\n* https://hyperbole.live now has inline documentation, code snippets, and live examples\n\nBreaking Changes:\n* A few functions now require state, such as `trigger` and `target`\n\n## 0.5.0 -- 2025-09-26\n\nImprovements\n* `trigger` actions in other views\n* Javascript FFI\n  * `window.Hyperbole` - API available from custom JS. `runAction` allows JS to trigger actions\n  * `pushEvent` - send events to JS from the server\n* Documents\n  * Choose to configure with `View DocumentHead ()` instead of `ByteString` `->` `ByteString`\n  * `quickStartDocument`\n  * Live Reload\n* Websocket - ping keepalive\n* New form fields: `radio`, `select`\n* `Web.Hyperbole.Effect.OAuth2` - Authentication \n* `Web.Hyperbole.Effect.GenRandom` - Simple random effect used by OAuth2\n* Error handling, custom errors\n* Examples\n  * Many additions and improvements\n  * External Stylesheet TodoMVC\n  * OAuth2 example\n\nBreaking Changes / Improvements\n* `Web.Atomic.CSS` overhauled, and is now opt-in. Use new `@` and `~` operators to apply attributes and styles\n* `Web.Hyperbole.Data.Param` - unified param encoding for Forms, ViewId, ViewAction, Sessions, Queries\n* `Web.Hyperbole.Data.Encoding` - encoding for ViewId, ViewAction\n* `Web.Hyperbole.Data.URI` - Standardize on `Network.URI`, extra utilities to manage paths\n* `trigger`: required refactor of `Page` type alias to support type-checking: `Eff es (Page '[])` is now `Page es '[]`\n\n## 0.4.3 -- 2025-01-31\n\n* Bug fixes and improvements\n\n## 0.4.2 -- 2025-01-21\n\n* Cleaner HyperView class [(@cgeorgii)](https://github.com/cgeorgii)\n  * data family Action\n  * update\n* Type-safe resolution of HyperViews\n* Record-based Forms\n  * textarea [(@tusharad)](https://github.com/tusharad)\n* High-level sessions and query params\n* Events: onLoad, onClick onInput, onSubmit, onDblClick, onKeyDown, onKeyUp\n* Major refactoring\n* Nix build and CI [(@Skyfold)](https://github.com/Skyfold)\n* New Examples Live: https://docs.hyperbole.live\n* New Examples Added:\n  * TodoMVC\n  * Forms - Simple\n  * DataTable\n  * Search - Filters\n  * Search - Autocomplete\n\n## 0.3.6 -- 2024-05-21\n\n* First version. Released on an unsuspecting world.\n"
  },
  {
    "path": "DOCTODO.md",
    "content": "Documentation Outline\n======================\n\n\n"
  },
  {
    "path": "Dockerfile",
    "content": "FROM haskell:9.8.2 AS base\nWORKDIR /opt/build\n\nRUN cabal update\nRUN 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\n\n\nFROM haskell:9.8.2 AS dependencies\nWORKDIR /opt/build\nCOPY --from=base /root/.cache /root/.cache\nCOPY --from=base /root/.local /root/.local\nCOPY --from=base /root/.config /root/.config\n\n# RUN apt-get update && apt-get install -y libpcre3 libpcre3-dev libcurl4-openssl-dev cron vim rsyslog\nADD ./package.yaml .\n# ADD ./cabal.project .\n# ADD ./docs/docgen.cabal .\n# ADD ./demo/demo.cabal .\nRUN hpack\nRUN cabal update\nRUN cabal build --only-dependencies\n\nFROM haskell:9.8.2 AS build\nWORKDIR /opt/build\nCOPY --from=dependencies /root/.cache /root/.cache\nCOPY --from=dependencies /root/.local /root/.local\nCOPY --from=dependencies /root/.config /root/.config\nADD ./package.yaml .\nADD ./cabal.project .\nADD ./client ./client\nADD ./test ./test\nADD ./src ./src\nADD ./demo ./demo\nADD ./docs ./docs\nADD *.md .\nADD LICENSE .\nRUN hpack\nRUN hpack demo\nRUN hpack docs\nRUN cabal build demo\nRUN mkdir bin\nRUN cd demo && export EXEC=$(cabal list-bin demo | tail -n1); cp \"$EXEC\" /opt/build/bin/demo\n\n\nFROM ubuntu:24.04 AS app\nWORKDIR /opt/app\n\nRUN apt-get update\nRUN apt-get install -y --no-install-recommends ca-certificates\nRUN update-ca-certificates && rm -rf /var/lib/apt/lists/*\n\nCOPY --from=build /opt/build/bin/demo ./bin/demo\nADD ./client ./client\nADD ./demo/static ./demo/static\n\n# ENV DYNAMO_LOCAL=False\nENTRYPOINT [\"/opt/app/bin/demo\"]\n"
  },
  {
    "path": "LICENSE",
    "content": "Copyright (c) 2023, Sean Hess\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n\n    * Redistributions of source code must retain the above copyright\n      notice, this list of conditions and the following disclaimer.\n\n    * Redistributions in binary form must reproduce the above\n      copyright notice, this list of conditions and the following\n      disclaimer in the documentation and/or other materials provided\n      with the distribution.\n\n    * Neither the name of Sean Hess nor the names of other\n      contributors may be used to endorse or promote products derived\n      from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\nLIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\nA PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\nOWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\nSPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\nLIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\nDATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\nTHEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n"
  },
  {
    "path": "README.md",
    "content": "![Hyperbole](https://github.com/seanhess/hyperbole/raw/main/demo/static/logo-robot.png)\n\n[![Hackage Version](https://img.shields.io/hackage/v/hyperbole?color=success)](https://hackage.haskell.org/package/hyperbole)\n\nCreate interactive HTML applications with type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView.\n\n[▶️ Simple Example](https://hyperbole.live/simple)\n\n```haskell\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Main where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nmain :: IO ()\nmain = do\n  run 3000 $ do\n    liveApp quickStartDocument (runPage page)\n\npage :: (Hyperbole :> es) => Page es '[Message]\npage = do\n  pure $ do\n    hyper Message1 $ messageView \"Hello\"\n    hyper Message2 $ messageView \"World!\"\n\ndata Message = Message1 | Message2\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = Louder Text\n    deriving (Generic, ViewAction)\n\n  update (Louder msg) = do\n    let new = msg <> \"!\"\n    pure $ messageView new\n\nmessageView :: Text -> View Message ()\nmessageView msg = do\n  button (Louder msg) ~ border 1 $ text msg\n```\n\n\n\nDocumentation\n-------------\n\nVisit [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)\n\n<a href=\"https://hyperbole.live\">\n  <img alt=\"Hyperbole Documentation\" src=\"https://github.com/seanhess/hyperbole/raw/main/demo/static/demo-screenshot.jpg\"/>\n</a>\n\n\n\n<!-- out of date!\n* [HaskRead](https://github.com/tusharad/Reddit-Clone-Haskell) - A Reddit Clone\n-->\n\nGetting Started with Cabal\n--------------------------\n\nCreate a new application:\n\n    $ mkdir myapp\n    $ cd myapp\n    $ cabal init\n\nAdd hyperbole and text as dependencies to the `.cabal` file:\n\n```\n    build-depends:\n        base\n      , hyperbole\n      , text\n\n    default-language: GHC2021\n```\n\nPaste the above example into Main.hs, then run it:\n\n    $ cabal run\n\nVisit http://localhost:3000 to view the application\n\n\nLearn More\n----------\n\n<!-- <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\"> -->\n<!--     <img src=\"https://github.com/seanhess/hyperbole/raw/main/docs/hackage.svg\"> -->\n<!-- </a> -->\n\n* [Local Development](./docs/dev.md)\n* [Comparison with Similar Frameworks](./docs/comparison.md)\n* [Using NIX](./docs/nix.md)\n\nIn the Wild\n---------------------\n\n<a href=\"https://nso.edu\">\n  <img alt=\"National Solar Observatory\" src=\"https://nso1.b-cdn.net/wp-content/uploads/2020/03/NSO-logo-orange-text.png\" width=\"400\"/>\n</a>\n\nThe 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/). \n\n\n\n\n\n\nContributors\n------------\n\n* [Sean Hess](seanhess)\n* [Kamil Figiela](https://github.com/kfigiela)\n* [Christian Georgii](https://github.com/cgeorgii)\n* [Pfalzgraf Martin](https://github.com/Skyfold)\n* [Tushar Adhatrao](https://github.com/tusharad)\n* [Benjamin Thomas](https://github.com/benjamin-thomas)\n* [Adithya Obilisetty](https://github.com/adithyaov)\n"
  },
  {
    "path": "bin/dev",
    "content": "#!/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 App.run -W --reload=./client/dist/hyperbole.js\n}\n\nclient() {\n  cd client\n  # npx webpack -w --mode=development\n  npx webpack -w\n}\n\n# run tests once (so we don't forget!)\ncabal test\n\n(trap 'kill 0' SIGINT; client & package && watch)\n"
  },
  {
    "path": "bin/docgen",
    "content": "#!/bin/bash\n\nset -e\n\nhpack demo\nhpack docs\ncabal run docs\n\ncd /tmp/hyperbole\ncabal haddock\n"
  },
  {
    "path": "bin/release",
    "content": "#!/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 webpack --mode=production\ncd ..\n\n\n# Compile the package\ncabal sdist\n\n# NEXT: Update branch release tags and push\n"
  },
  {
    "path": "cabal.project",
    "content": "tests: True\nmulti-repl: True\npackages:\n  .\n  ./demo/\n  ./docs/\n"
  },
  {
    "path": "client/declarations.d.ts",
    "content": "declare module 'omdomdom/lib/omdomdom.es.js' {\n  export function create(node: any, ...args: any[]): any;\n  export function patch(template: any, vNode: any, rootNode?: any): void;\n  export function render(vNode: any, root: any): void;\n}\n\n"
  },
  {
    "path": "client/dist/action.d.ts",
    "content": "import { Meta, ViewId, RequestId, EncodedAction, ViewState } from \"./message\";\nexport type ActionMessage = {\n    viewId: ViewId;\n    action: EncodedAction;\n    requestId: RequestId;\n    state?: ViewState;\n    meta: Meta[];\n    form: URLSearchParams | undefined;\n};\nexport declare function actionMessage(id: ViewId, action: EncodedAction, state: ViewState | undefined, reqId: RequestId, form?: FormData): ActionMessage;\nexport declare function toSearch(form?: FormData): URLSearchParams | undefined;\nexport declare function renderActionMessage(msg: ActionMessage): string;\nexport declare function renderForm(form: URLSearchParams | undefined): string;\nexport type Request = {\n    requestId: RequestId;\n    isCancelled: boolean;\n};\nexport declare function newRequest(): Request;\nexport declare function encodedParam(action: string, param: string): string;\n"
  },
  {
    "path": "client/dist/browser.d.ts",
    "content": "export declare function setQuery(query: string): void;\n"
  },
  {
    "path": "client/dist/events.d.ts",
    "content": "import { HyperView } from './hyperview';\nexport type UrlFragment = string;\nexport declare function listenKeydown(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenKeyup(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenKeyEvent(event: \"keyup\" | \"keydown\", cb: (target: HyperView, action: string) => void): void;\nexport declare function listenBubblingEvent(event: string, cb: (_target: HyperView, action: string) => void): void;\nexport declare function listenClick(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenDblClick(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenTopLevel(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenLoad(node: HTMLElement): void;\nexport declare function listenMouseEnter(node: HTMLElement): void;\nexport declare function listenMouseLeave(node: HTMLElement): void;\nexport declare function listenChange(cb: (target: HyperView, action: string) => void): void;\nexport declare function listenInput(startedTyping: (target: HyperView) => void, cb: (target: HyperView, action: string) => void): void;\nexport declare function listenFormSubmit(cb: (target: HyperView, action: string, form: FormData) => void): void;\n"
  },
  {
    "path": "client/dist/http.d.ts",
    "content": ""
  },
  {
    "path": "client/dist/hyperbole.js",
    "content": "/*! For license information please see hyperbole.js.LICENSE.txt */\n(()=>{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}})()})();\n//# sourceMappingURL=hyperbole.js.map"
  },
  {
    "path": "client/dist/hyperview.d.ts",
    "content": "import { type Request } from \"./action\";\nexport interface HyperView extends HTMLElement {\n    runAction(action: string): Promise<void>;\n    activeRequest?: Request;\n    cancelActiveRequest(): void;\n    concurrency: ConcurrencyMode;\n    _timeout?: number;\n}\nexport declare const isHyperView: (ele: any) => ele is HyperView;\nexport type ConcurrencyMode = string;\nexport declare function dispatchContent(node: HTMLElement): void;\nexport declare function enrichHyperViews(node: HTMLElement, runAction: (target: HyperView, action: string, form?: FormData) => Promise<void>): void;\n"
  },
  {
    "path": "client/dist/index.d.ts",
    "content": "import { SocketConnection } from './sockets';\nimport { ViewId, Metadata } from './message';\nimport { HyperView } from \"./hyperview\";\ndeclare global {\n    interface Window {\n        Hyperbole?: HyperboleAPI;\n    }\n    interface DocumentEventMap {\n        \"hyp-load\": CustomEvent;\n        \"hyp-mouseenter\": CustomEvent;\n        \"hyp-mouseleave\": CustomEvent;\n    }\n}\nexport interface HyperboleAPI {\n    runAction(target: HTMLElement, action: string, form?: FormData): Promise<void>;\n    action(con: string, ...params: any[]): string;\n    hyperView(viewId: ViewId): HyperView | undefined;\n    parseMetadata(input: string): Metadata;\n    socket: SocketConnection;\n}\n"
  },
  {
    "path": "client/dist/lib.d.ts",
    "content": "export declare function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[];\nexport declare function dropWhile<T, A>(pred: (val: T) => A | undefined, lines: T[]): T[];\n"
  },
  {
    "path": "client/dist/message.d.ts",
    "content": "export type Meta = {\n    key: string;\n    value: string;\n};\nexport type ViewId = string;\nexport type RequestId = number;\nexport type EncodedAction = string;\nexport type ViewState = string;\nexport type RemoteEvent = {\n    name: string;\n    detail: unknown;\n};\nexport declare function renderMetas(meta: Meta[]): string;\nexport type Metadata = {\n    cookies?: string[];\n    error?: string;\n    query?: string;\n    events?: RemoteEvent[];\n    actions?: [ViewId, EncodedAction][];\n    pageTitle?: string;\n};\nexport declare function toMetadata(meta: Meta[]): Metadata;\nexport declare function parseMetadata(input: string): Metadata;\nexport declare function metaValue(key: string, metas: Meta[]): string | undefined;\nexport declare function metaValuesAll(key: string, metas: Meta[]): string[];\nexport type SplitMessage = {\n    command: string;\n    metas: Meta[];\n    rest: string[];\n};\nexport declare function splitMessage(message: string): SplitMessage;\nexport declare function parseMeta(line: string): Meta | undefined;\nexport declare function parseRemoteEvent(input: string): RemoteEvent;\nexport declare function parseAction(input: string): [ViewId, string];\n"
  },
  {
    "path": "client/dist/response.d.ts",
    "content": "import { ViewId, Metadata } from './message';\nexport type Response = {\n    meta: Metadata;\n    body: ResponseBody;\n};\nexport type ResponseBody = string;\nexport declare function parseResponse(res: ResponseBody): LiveUpdate;\nexport type LiveUpdate = {\n    content: HTMLElement | null;\n    css: HTMLStyleElement | null;\n};\nexport declare class FetchError extends Error {\n    viewId: ViewId;\n    body: string;\n    constructor(viewId: ViewId, msg: string, body: string);\n}\n"
  },
  {
    "path": "client/dist/sockets.d.ts",
    "content": "import { ActionMessage } from './action';\nimport { ResponseBody } from \"./response\";\nimport { ViewId, RequestId, EncodedAction, Metadata, RemoteEvent } from \"./message\";\ninterface SocketConnectionEventMap {\n    \"update\": CustomEvent<Update>;\n    \"response\": CustomEvent<Update>;\n    \"redirect\": CustomEvent<Redirect>;\n    \"trigger\": CustomEvent<Trigger>;\n    \"event\": CustomEvent<JSEvent>;\n}\nexport declare class SocketConnection {\n    socket: WebSocket;\n    hasEverConnected: Boolean;\n    isConnected: Boolean;\n    reconnectDelay: number;\n    queue: ActionMessage[];\n    events: EventTarget;\n    constructor(addr?: string);\n    connect(addr?: string, createSocket?: boolean): void;\n    sendAction(action: ActionMessage): Promise<void>;\n    private runQueue;\n    private onMessage;\n    addEventListener<K extends keyof SocketConnectionEventMap>(e: K, cb: (ev: SocketConnectionEventMap[K]) => void): void;\n    dispatchEvent<K extends keyof SocketConnectionEventMap>(e: SocketConnectionEventMap[K]): void;\n    disconnect(): void;\n}\nexport type Update = {\n    requestId: RequestId;\n    meta: Metadata;\n    viewId: ViewId;\n    targetViewId?: ViewId;\n    action: EncodedAction;\n    body: ResponseBody;\n};\nexport type Redirect = {\n    requestId: RequestId;\n    meta: Metadata;\n    url: string;\n};\nexport type Trigger = {\n    requestId: RequestId;\n    meta: Metadata;\n    viewId: ViewId;\n    action: EncodedAction;\n    targetViewId: ViewId;\n    targetAction: string;\n};\nexport type JSEvent = {\n    requestId: RequestId;\n    meta: Metadata;\n    viewId: ViewId;\n    action: EncodedAction;\n    event: RemoteEvent;\n};\nexport type MessageType = string;\nexport declare class ProtocolError extends Error {\n    constructor(description: string, body: string);\n}\nexport {};\n"
  },
  {
    "path": "client/package.json",
    "content": "{\n  \"name\": \"web-ui\",\n  \"version\": \"0.6.0\",\n  \"description\": \"Development -----------\",\n  \"main\": \"index.js\",\n  \"directories\": {\n    \"client\": \"client\"\n  },\n  \"scripts\": {\n    \"build\": \"npx webpack\"\n  },\n  \"author\": \"\",\n  \"license\": \"ISC\",\n  \"devDependencies\": {\n    \"ts-loader\": \"^9.4.1\",\n    \"typescript\": \"^4.8.3\",\n    \"uglify\": \"^0.1.5\",\n    \"webpack\": \"^5.88.2\",\n    \"webpack-cli\": \"^4.10.0\"\n  },\n  \"dependencies\": {\n    \"omdomdom\": \"^0.3.2\",\n    \"debounce\": \"^2.2.0\"\n  }\n}\n"
  },
  {
    "path": "client/src/action.ts",
    "content": "\nimport { takeWhileMap } from \"./lib\"\nimport { Meta, ViewId, RequestId, EncodedAction, ViewState } from \"./message\"\nimport * as message from \"./message\"\n\n\n\nexport type ActionMessage = {\n  viewId: ViewId\n  action: EncodedAction\n  requestId: RequestId\n  state?: ViewState\n  meta: Meta[]\n  form: URLSearchParams | undefined\n}\n\n\n\n\nexport function actionMessage(id: ViewId, action: EncodedAction, state: ViewState | undefined, reqId: RequestId, form?: FormData): ActionMessage {\n  let meta: Meta[] = [\n    { key: \"Cookie\", value: decodeURI(document.cookie) },\n    { key: \"Query\", value: window.location.search }\n  ]\n\n  return { viewId: id, action, state, requestId: reqId, meta, form: toSearch(form) }\n}\n\nexport function toSearch(form?: FormData): URLSearchParams | undefined {\n  if (!form) return undefined\n\n  const params = new URLSearchParams()\n\n  form.forEach((value, key) => {\n    params.append(key, value as string)\n  })\n\n  return params\n}\n\nexport function renderActionMessage(msg: ActionMessage): string {\n  let header = [\n    \"|ACTION|\",\n    \"ViewId: \" + msg.viewId,\n    \"Action: \" + msg.action,\n  ]\n\n\n  if (msg.state) {\n    header.push(\"State: \" + msg.state)\n  }\n\n  header.push(\"RequestId: \" + msg.requestId)\n\n  return [\n    header.join('\\n'),\n    message.renderMetas(msg.meta),\n  ].join('\\n') + renderForm(msg.form)\n}\n\n\nexport function renderForm(form: URLSearchParams | undefined): string {\n  if (!form) return \"\"\n  return \"\\n\\n\" + form\n}\n\nlet globalRequestId: RequestId = 0\n\nexport type Request = {\n  requestId: RequestId\n  isCancelled: boolean\n}\n\nexport function newRequest(): Request {\n  let requestId = ++globalRequestId\n  return { requestId, isCancelled: false }\n}\n\n\n\n// Sanitized Encoding ------------------------------------\n\nexport function encodedParam(action: string, param: string): string {\n  return action + ' ' + sanitizeParam(param)\n}\n\nfunction sanitizeParam(param: string): string {\n  if (param == \"\") {\n    return \"|\"\n  }\n\n  return param.replace(/_/g, \"\\\\_\").replace(/\\s+/g, \"_\")\n}\n"
  },
  {
    "path": "client/src/browser.ts",
    "content": "\nexport function setQuery(query: string) {\n  if (query != currentQuery()) {\n    if (query != \"\") query = \"?\" + query\n    let url = location.pathname + query\n    // console.log(\"history.replaceState(\", url, \")\")\n    window.history.replaceState({}, \"\", url)\n  }\n}\n\nfunction currentQuery(): string {\n  const query = window.location.search;\n  return query.startsWith('?') ? query.substring(1) : query;\n}\n"
  },
  {
    "path": "client/src/events.ts",
    "content": "\nimport * as debounce from 'debounce'\nimport { encodedParam } from './action'\nimport { HyperView, isHyperView } from './hyperview'\n\nexport type UrlFragment = string\n\nexport function listenKeydown(cb: (target: HyperView, action: string) => void): void {\n  listenKeyEvent(\"keydown\", cb)\n}\n\nexport function listenKeyup(cb: (target: HyperView, action: string) => void): void {\n  listenKeyEvent(\"keyup\", cb)\n}\n\nexport function listenKeyEvent(event: \"keyup\" | \"keydown\", cb: (target: HyperView, action: string) => void): void {\n\n  document.addEventListener(event, function(e: KeyboardEvent) {\n    if (!(e.target instanceof HTMLElement)) {\n      console.warn(\"listenKeyEvent received event with non HTMLElment as EventTarget: %o\", e)\n      return\n    }\n    let source = e.target\n\n    let datasetKey = \"on\" + event + e.key\n    let action = source.dataset[datasetKey]\n    if (!action) return\n\n    e.preventDefault()\n    const target =  nearestHyperViewTarget(source)\n    if (!target) {\n      console.error(\"Missing target: \", source)\n      return\n    }\n    cb(target, action)\n  })\n}\n\nexport function listenBubblingEvent(event: string, cb: (_target: HyperView, action: string) => void): void {\n  document.addEventListener(event, function(e) {\n    if (!(e.target instanceof HTMLElement)) {\n      console.warn(\"listenBubblingEvent received an event with non HTMLElment as EventTarget: %o\", e)\n      return\n    }\n    let el = e.target\n\n    // clicks can fire on internal elements. Find the parent with a click handler\n    let source = el.closest<HTMLElement>(\"[data-on\" + event + \"]\")\n    if (!source) return\n\n    e.preventDefault()\n    let target = nearestHyperViewTarget(source)\n    if (!target) {\n      console.error(\"Missing target: \", source)\n      return\n    }\n    const action = source.dataset[\"on\" + event]\n    if (action === undefined) {\n      console.error(\"Missing action: \", source, event)\n      return\n    }\n    cb(target, action)\n  })\n}\n\nexport function listenClick(cb: (target: HyperView, action: string) => void): void {\n  listenBubblingEvent(\"click\", cb)\n}\n\nexport function listenDblClick(cb: (target: HyperView, action: string) => void): void {\n  listenBubblingEvent(\"dblclick\", cb)\n}\n\n\nexport function listenTopLevel(cb: (target: HyperView, action: string) => void): void {\n  document.addEventListener(\"hyp-load\", function(e: CustomEvent) {\n    let action = e.detail.onLoad\n    let target = e.detail.target\n    cb(target, action)\n  })\n\n  document.addEventListener(\"hyp-mouseenter\", function(e: CustomEvent) {\n    let action = e.detail.onMouseEnter\n    let target = e.detail.target\n    cb(target, action)\n  })\n\n  document.addEventListener(\"hyp-mouseleave\", function(e: CustomEvent) {\n    let action = e.detail.onMouseLeave\n    let target = e.detail.target\n    cb(target, action)\n  })\n}\n\n\nexport function listenLoad(node: HTMLElement): void {\n\n  // it doesn't really matter WHO runs this except that it should have target\n  node.querySelectorAll<HTMLElement>(\"[data-onload]\").forEach((load) => {\n    let delay = parseInt(load.dataset.delay || \"\") || 0\n    let onLoad = load.dataset.onload\n    // console.log(\"load start\", load.dataset.onLoad)\n\n    // load no longer exists!\n    // we should clear the timeout or back out if the dom is replaced in the interem\n    setTimeout(() => {\n      let target = nearestHyperViewTarget(load)\n      // console.log(\"load go\", load.dataset.onLoad)\n\n      if (load.dataset.onload != onLoad) {\n        // the onLoad no longer exists\n        return\n      }\n\n      const event = new CustomEvent(\"hyp-load\", { bubbles: true, detail: { target, onLoad } })\n      load.dispatchEvent(event)\n    }, delay)\n  })\n}\n\nexport function listenMouseEnter(node: HTMLElement): void {\n  node.querySelectorAll<HTMLElement>(\"[data-onmouseenter]\").forEach((node) => {\n    let onMouseEnter = node.dataset.onmouseenter\n\n    let target = nearestAnyTarget(node)\n\n    node.onmouseenter = () => {\n      const event = new CustomEvent(\"hyp-mouseenter\", { bubbles: true, detail: { target, onMouseEnter } })\n      node.dispatchEvent(event)\n    }\n  })\n}\n\nexport function listenMouseLeave(node: HTMLElement): void {\n  node.querySelectorAll<HTMLElement>(\"[data-onmouseleave]\").forEach((node) => {\n    let onMouseLeave = node.dataset.onmouseleave\n\n    let target = nearestAnyTarget(node)\n\n    node.onmouseleave = () => {\n      const event = new CustomEvent(\"hyp-mouseleave\", { bubbles: true, detail: { target, onMouseLeave } })\n      node.dispatchEvent(event)\n    }\n  })\n}\n\n\nexport function listenChange(cb: (target: HyperView, action: string) => void): void {\n  document.addEventListener(\"change\", function(e) {\n    if (!(e.target instanceof HTMLElement)) {\n      console.warn(\"listenChange received an event with non HTMLElment as EventTarget: %o\", e)\n      return\n    }\n    let el = e.target\n\n    let source = el.closest<HTMLInputElement>(\"[data-onchange]\")\n\n    if (!source) return\n    e.preventDefault()\n\n    if (source.value === null) {\n      console.error(\"Missing input value:\", source)\n      return\n    }\n\n    let target = nearestHyperViewTarget(source)\n    if (!target) {\n      console.error(\"Missing target: listenChange\")\n      return\n    }\n    if (!source.dataset.onchange) {\n      console.error(\"Missing onchange: \", source)\n      return\n    }\n    let action = encodedParam(source.dataset.onchange, source.value)\n    cb(target, action)\n  })\n}\n\ninterface LiveInputElement extends HTMLInputElement {\n  debouncedCallback?: Function;\n}\n\nexport function listenInput(startedTyping: (target: HyperView) => void, cb: (target: HyperView, action: string) => void): void {\n  document.addEventListener(\"input\", function(e) {\n    if (!(e.target instanceof HTMLElement)) {\n      console.warn(\"listenInput received an event with non HTMLElment as EventTarget: %o\", e)\n      return\n    }\n    let el = e.target\n    const source = el.closest<LiveInputElement>(\"[data-oninput]\")\n\n    if (!source) return\n\n    let delay = parseInt(source.dataset.delay || \"\") || 250\n    if (delay < 250) {\n      console.warn(\"Input delay < 250 can result in poor performance.\")\n    }\n\n    e.preventDefault()\n\n    const target = nearestHyperViewTarget(source)\n    if (!target) {\n      console.error(\"Missing target: \", source)\n      return\n    }\n\n    // I want to CANCEL the active request as soon as we start typing\n    startedTyping(target)\n\n    if (!source.debouncedCallback) {\n      source.debouncedCallback = debounce(() => {\n        if (!source.dataset.oninput) {\n          console.error(\"Missing onInput: \", source)\n          return\n        }\n        const action = encodedParam(source.dataset.oninput, source.value)\n        cb(target, action)\n      }, delay)\n    }\n\n    source.debouncedCallback()\n  })\n}\n\n\n\nexport function listenFormSubmit(cb: (target: HyperView, action: string, form: FormData) => void): void {\n  document.addEventListener(\"submit\", function(e) {\n    if (!(e.target instanceof HTMLFormElement)) {\n      console.warn(\"listenFormSubmit received an event with non HTMLElment as EventTarget: %o\", e)\n      return\n    }\n    let form = e.target\n\n\n    if (!form.dataset.onsubmit) {\n      console.error(\"Missing onSubmit: \", form)\n      return\n    }\n\n    e.preventDefault()\n\n    let target = nearestHyperViewTarget(form)\n    const formData = new FormData(form)\n    if (!target) {\n      console.error(\"Missing target: \", form)\n      return\n    }\n    cb(target, form.dataset.onsubmit, formData)\n  })\n}\n\nfunction nearestTargetId(node: HTMLElement): string | undefined {\n  let targetData = node.closest<HTMLElement>(\"[data-target]\")\n  return targetData?.dataset.target || node.closest(\"[id]\")?.id\n}\n\nfunction nearestHyperViewTarget(node: HTMLElement): HyperView | undefined {\n  const target = nearestAnyTarget(node)\n\n  if (!isHyperView(target)) {\n    console.error(\"Non HyperView target: \", target)\n    return\n  }\n\n  return target\n}\n\nfunction nearestAnyTarget(node: HTMLElement): HTMLElement | undefined {\n  let targetId = nearestTargetId(node)\n  let target = targetId && document.getElementById(targetId)\n\n  if (!target) {\n    console.error(\"Cannot find target: \", targetId, node)\n    return\n  }\n\n  return target\n}\n"
  },
  {
    "path": "client/src/http.ts",
    "content": "// import { ActionMessage, ParsedResponse } from './action'\n// import { Response, FetchError } from \"./response\"\n\n// export async function sendActionHttp(msg: ActionMessage): Promise<Response> {\n//   // console.log(\"HTTP sendAction\", msg.url.toString())\n//   let url = window.location.href\n//   let res = await fetch(url, {\n//     method: \"POST\",\n//     headers:\n//     {\n//       'Accept': 'text/html',\n//       'Content-Type': 'application/x-www-form-urlencoded',\n//       'Hyp-RequestId': msg.requestId,\n//       'Hyp-ViewId': msg.viewId,\n//       'Hyp-Action': msg.action\n//     },\n//     body: msg.form,\n//     // we never want this to be redirected\n//     redirect: \"manual\"\n//   })\n//\n//   let body = await res.text()\n//   let { metadata, rest } = parseMetadataHttp(body)\n//\n//   if (!res.ok) {\n//     throw new FetchError(msg.viewId, body, body)\n//   }\n//\n//   let response: Response = {\n//     meta: metadata,\n//     body: rest.join('\\n')\n//   }\n//\n//   return response\n// }\n\n\n// export function parseMetadataHttp(inp: string): ParsedResponse {\n//   let lines = inp.split(\"\\n\")\n//   // drop the <script> start line\n//   let { metadata, rest } = splitMetadata(lines.slice(1))\n//   // drop the </script> end line and 2x whitespace\n//   return { metadata, rest: rest.slice(2) }\n// }\n//\n//\n"
  },
  {
    "path": "client/src/hyperview.ts",
    "content": "import { type Request } from \"./action\";\n\nexport interface HyperView extends HTMLElement {\n  runAction(action: string): Promise<void>;\n  activeRequest?: Request;\n  cancelActiveRequest(): void;\n  concurrency: ConcurrencyMode;\n  _timeout?: number;\n}\n\nexport const isHyperView = (ele: any): ele is HyperView => {\n  return ele?.runAction !== undefined;\n};\n\nexport type ConcurrencyMode = string;\n\nexport function dispatchContent(node: HTMLElement): void {\n  let event = new Event(\"hyp-content\", { bubbles: true })\n  node.dispatchEvent(event)\n}\n\nexport function enrichHyperViews(node: HTMLElement, runAction: (target: HyperView, action: string, form?: FormData) => Promise<void>): void {\n  // enrich all the hyperviews\n  node.querySelectorAll<HyperView>(\"[id]\").forEach((element) => {\n    element.runAction = function(action: string) {\n      return runAction(element, action)\n    }\n\n    element.concurrency = element.dataset.concurrency || \"Drop\"\n\n    element.cancelActiveRequest = function() {\n      if (element.activeRequest && !element.activeRequest?.isCancelled) {\n        element.activeRequest.isCancelled = true\n      }\n    }\n\n    dispatchContent(node)\n  })\n}\n"
  },
  {
    "path": "client/src/index.ts",
    "content": "import { patch, create } from \"omdomdom/lib/omdomdom.es.js\"\nimport { SocketConnection, Update, Redirect, Trigger, JSEvent } from './sockets'\nimport { listenChange, listenClick, listenDblClick, listenFormSubmit, listenLoad, listenTopLevel, listenInput, listenKeydown, listenKeyup, listenMouseEnter, listenMouseLeave } from './events'\nimport { actionMessage, newRequest } from './action'\nimport { ViewId, Metadata, parseMetadata, RemoteEvent, EncodedAction } from './message'\nimport { setQuery } from \"./browser\"\nimport { parseResponse, LiveUpdate } from './response'\nimport { dispatchContent, enrichHyperViews, HyperView, isHyperView } from \"./hyperview\"\n\nlet PACKAGE = require('../package.json');\n\n\n// console.log(\"VERSION 2\", INIT_PAGE, INIT_STATE)\nconsole.log(\"Hyperbole \" + PACKAGE.version + \"b\")\n\n\nlet rootStyles: HTMLStyleElement;\nlet addedRulesIndex = new Set();\n\n\n\n\n\n// Run an action in a given HyperView\nasync function runAction(target: HyperView, action: string, form?: FormData) {\n\n  if (target.activeRequest && !target.activeRequest?.isCancelled) {\n    // Active Request!\n    if (target.concurrency == \"Drop\") {\n      console.warn(\"Drop action overlapping with active request (\" + target.activeRequest + \")\", action)\n      return\n    }\n  }\n\n  target._timeout = window.setTimeout(() => {\n    // add loading after 100ms, not right away\n    // if it runs shorter than that we probably don't want to show the user any loading feedback\n    target.classList.add(\"hyp-loading\")\n  }, 100)\n\n  let state = target.dataset.state\n\n  let req = newRequest()\n  let msg = actionMessage(target.id, action, state, req.requestId, form)\n\n  // Set the requestId\n  target.activeRequest = req\n\n  sock.sendAction(msg)\n}\n\nfunction handleTrigger(trigger: Trigger) {\n  runTrigger(trigger.targetViewId, trigger.targetAction)\n}\n\nfunction handleEvent(ev: JSEvent) {\n  let target = document.getElementById(ev.viewId)\n  runRemoteEvent(ev.event, target)\n}\n\n// TODO: redirect concurrency\nfunction handleRedirect(red: Redirect) {\n  console.log(\"REDIRECT\", red)\n\n  // the other metdata doesn't apply, they are all specific to the page\n  applyCookies(red.meta.cookies ?? [])\n\n  window.location.href = red.url\n}\n\n// in-process update\nfunction handleResponse(res: Update) {\n  // console.log(\"Handle Response\", res)\n  let target = handleUpdate(res)\n  if (!target) return\n\n  // clean up the request\n  delete target.activeRequest\n  clearTimeout(target._timeout)\n  target.classList.remove(\"hyp-loading\")\n}\n\nfunction handleUpdate(res: Update): HyperView | undefined {\n  // console.log(\"|UPDATE|\", res)\n\n  let targetViewId = res.targetViewId || res.viewId\n  let target = document.getElementById(targetViewId)\n\n  if (!isHyperView(target)) {\n    console.error(\"Missing Update HyperView Target: \", targetViewId, res)\n    return\n  }\n\n  if (target.activeRequest?.requestId && res.requestId < target.activeRequest.requestId) {\n    // this should only happen on Replace, since other requests should be dropped\n    // but it's safe to assume we never want to apply an old requestId\n    console.warn(\"Ignore Stale Action (\" + res.requestId + \") vs (\" + target.activeRequest.requestId + \"): \" + res.action)\n    return target\n  }\n  else if (target.activeRequest?.isCancelled) {\n    console.warn(\"Cancelled request\", target.activeRequest?.requestId)\n    delete target.activeRequest\n    return target\n  }\n\n  let update: LiveUpdate = parseResponse(res.body)\n\n  if (!update.content) {\n    console.error(\"Empty Response!\", res.body)\n    return target\n  }\n\n  // First, update the stylesheet\n  addCSS(update.css)\n\n\n  // Patch the node\n  const old: VNode = create(target)\n  let next: VNode = create(update.content)\n  let atts = next.attributes\n\n  if (!res.meta.error && atts[\"id\"] != target.id) {\n    console.error(\"Mismatched ViewId in update - \", atts[\"id\"], \" target:\", target.id)\n    return\n  }\n\n  let state = atts[\"data-state\"]\n  next.attributes = old.attributes\n\n\n  patch(next, old)\n\n\n  // Emit relevant events\n  let newTarget = document.getElementById(target.id)\n\n  if (!newTarget) {\n    console.warn(\"Target Missing: \", target.id)\n    return target\n  }\n\n  dispatchContent(newTarget)\n\n  // re-add state attribute \n  if (state === undefined || state == \"()\")\n    delete newTarget.dataset.state\n  else\n    newTarget.dataset.state = state\n\n  // execute the metadata, anything that doesn't interrupt the dom update\n  runMetadata(res.meta, newTarget)\n  applyCookies(res.meta.cookies ?? [])\n\n  // now way for these to bubble)\n  listenLoad(newTarget)\n  listenMouseEnter(newTarget)\n  listenMouseLeave(newTarget)\n  fixInputs(newTarget)\n  enrichHyperViews(newTarget, runAction)\n\n  return target\n}\n// catch (err) {\n//   console.error(\"Caught Error in HyperView (\" + target.id + \"):\\n\", err)\n//\n//   // Hyperbole catches handler errors, and the server controls what to display to the user on an error\n//   //  but if you manage to crash your parent server process somehow, the response may be empty\n//   target.innerHTML = err.body || \"<div style='background:red;color:white;padding:10px'>Hyperbole Internal Error</div>\"\n// }\n\nfunction applyCookies(cookies: string[]) {\n  cookies.forEach((cookie: string) => {\n    console.log(\"SetCookie: \", cookie)\n    document.cookie = cookie\n  })\n}\n\nfunction runMetadata(meta: Metadata, target: HTMLElement | null) {\n  if (meta.query != null) {\n    setQuery(meta.query)\n  }\n\n  if (meta.pageTitle != null) {\n    document.title = meta.pageTitle\n  }\n\n  meta.events?.forEach((remoteEvent) => {\n    runRemoteEvent(remoteEvent, target)\n  })\n\n  meta.actions?.forEach(([viewId, action]) => {\n    runTrigger(viewId, action)\n  })\n}\n\nfunction runRemoteEvent(remoteEvent: RemoteEvent, target: HTMLElement | null) {\n  setTimeout(() => {\n    let event = new CustomEvent(remoteEvent.name, { bubbles: true, detail: remoteEvent.detail })\n    let eventTarget = target || document\n    eventTarget.dispatchEvent(event)\n  }, 10)\n}\n\nfunction runTrigger(viewId: ViewId, action: EncodedAction) {\n  setTimeout(() => {\n    let view = window.Hyperbole?.hyperView(viewId)\n    if (view) {\n      runAction(view, action)\n    }\n  }, 10)\n}\n\n\nfunction fixInputs(target: HTMLElement) {\n  let focused = target.querySelector<HTMLInputElement>(\"[autofocus]\")\n  if (focused?.focus) {\n    focused.focus()\n  }\n\n  target.querySelectorAll<HTMLInputElement>(\"input[value]\").forEach((input) => {\n    let val = input.getAttribute(\"value\")\n    if (val !== null) {\n      input.value = val\n    }\n  })\n\n  target.querySelectorAll<HTMLInputElement>(\"input[type=checkbox]\").forEach((checkbox) => {\n    let checked = checkbox.dataset.checked == \"True\"\n    checkbox.checked = checked\n  })\n}\n\nfunction addCSS(src: HTMLStyleElement | null) {\n  if (!src) return;\n  const rules = src.sheet?.cssRules\n  if (!rules) return;\n  for (let i = 0; i < rules.length; i++) {\n    const rule = rules.item(i)\n    if (rule && addedRulesIndex.has(rule.cssText) == false && rootStyles.sheet) {\n      rootStyles.sheet.insertRule(rule.cssText);\n      addedRulesIndex.add(rule.cssText);\n    }\n  }\n}\n\n\n\n\nfunction init() {\n  // metadata attached to initial page loads need to be executed\n  let meta = parseMetadata(document.getElementById(\"hyp.metadata\")?.innerText ?? \"\")\n  // runMetadataImmediate(meta)\n  runMetadata(meta, null)\n\n  const style = document.body.querySelector('style')\n\n  if (style !== null) {\n    rootStyles = style\n  } else {\n    console.warn(\"rootStyles missing from page, creating...\")\n    rootStyles = document.createElement(\"style\")\n    rootStyles.type = \"text/css\"\n    document.body.appendChild(rootStyles)\n  }\n\n  listenTopLevel(async function(target: HyperView, action: string) {\n    runAction(target, action)\n  })\n\n  listenLoad(document.body)\n  listenMouseEnter(document.body)\n  listenMouseLeave(document.body)\n  enrichHyperViews(document.body, runAction)\n\n\n  listenClick(async function(target: HyperView, action: string) {\n    // console.log(\"CLICK\", target.id, action)\n    runAction(target, action)\n  })\n\n  listenDblClick(async function(target: HyperView, action: string) {\n    // console.log(\"DBLCLICK\", target.id, action)\n    runAction(target, action)\n  })\n\n  listenKeydown(async function(target: HyperView, action: string) {\n    // console.log(\"KEYDOWN\", target.id, action)\n    runAction(target, action)\n  })\n\n  listenKeyup(async function(target: HyperView, action: string) {\n    // console.log(\"KEYUP\", target.id, action)\n    runAction(target, action)\n  })\n\n  listenFormSubmit(async function(target: HyperView, action: string, form: FormData) {\n    // console.log(\"FORM\", target.id, action, form)\n    runAction(target, action, form)\n  })\n\n  listenChange(async function(target: HyperView, action: string) {\n    runAction(target, action)\n  })\n\n  function onStartedTyping(target: HyperView) {\n    if (target.concurrency == \"Replace\") {\n      target.cancelActiveRequest()\n    }\n  }\n\n  listenInput(onStartedTyping, async function(target: HyperView, action: string) {\n    runAction(target, action)\n  })\n}\n\n\n\n\n\n\ndocument.addEventListener(\"DOMContentLoaded\", init)\n\n\n\n\nconst sock = new SocketConnection()\n// Should we connect to the socket or not?\nsock.connect()\nsock.addEventListener(\"update\", (ev: CustomEvent<Update>) => { handleUpdate(ev.detail) })\nsock.addEventListener(\"response\", (ev: CustomEvent<Update>) => handleResponse(ev.detail))\nsock.addEventListener(\"redirect\", (ev: CustomEvent<Redirect>) => handleRedirect(ev.detail))\nsock.addEventListener(\"trigger\", (ev: CustomEvent<Trigger>) => handleTrigger(ev.detail))\nsock.addEventListener(\"event\", (ev: CustomEvent<JSEvent>) => handleEvent(ev.detail))\n\n\n\n\n\ntype VNode = {\n  // One of three value types are used:\n  // - The tag name of the element\n  // - \"text\" if text node\n  // - \"comment\" if comment node\n  type: string\n\n  // An object whose key/value pairs are the attribute\n  // name and value, respectively\n  attributes: { [key: string]: string | undefined }\n\n  // Is set to `true` if a node is an `svg`, which tells\n  // Omdomdom to treat it, and its children, as such\n  isSVGContext: Boolean\n\n  // The content of a \"text\" or \"comment\" node\n  content: string\n\n  // An array of virtual node children\n  children: Array<VNode>\n\n  // The real DOM node\n  node: Node\n}\n\n\n\n\n\ndeclare global {\n  interface Window {\n    Hyperbole?: HyperboleAPI;\n  }\n  interface DocumentEventMap {\n    \"hyp-load\": CustomEvent;\n    \"hyp-mouseenter\": CustomEvent;\n    \"hyp-mouseleave\": CustomEvent;\n  }\n}\n\nexport interface HyperboleAPI {\n  runAction(target: HTMLElement, action: string, form?: FormData): Promise<void>\n  action(con: string, ...params: any[]): string\n  hyperView(viewId: ViewId): HyperView | undefined\n  parseMetadata(input: string): Metadata\n  socket: SocketConnection\n}\n\nwindow.Hyperbole =\n{\n  runAction: runAction,\n  parseMetadata: parseMetadata,\n  action: function(con, ...params: any[]) {\n    return params.reduce((str, param) => str + \" \" + JSON.stringify(param), con);\n  },\n  hyperView: function(viewId) {\n    let element = document.getElementById(viewId)\n    if (!isHyperView(element)) {\n      console.error(\"Element id=\" + viewId + \" was not a HyperView\")\n      return\n    }\n    return element\n  },\n  socket: sock\n}\n"
  },
  {
    "path": "client/src/lib.ts",
    "content": "\n\nexport function takeWhileMap<T, A>(pred: (val: T) => A | undefined, lines: T[]): A[] {\n  var output = []\n  for (var line of lines) {\n    let a = pred(line)\n    if (a)\n      output.push(a)\n    else\n      break;\n  }\n\n  return output\n}\n\nexport function dropWhile<T, A>(pred: (val: T) => A | undefined, lines: T[]): T[] {\n  let index = 0;\n  while (index < lines.length && pred(lines[index])) {\n    index++;\n  }\n  return lines.slice(index);\n}\n\n"
  },
  {
    "path": "client/src/message.ts",
    "content": "\nimport { takeWhileMap, dropWhile } from \"./lib\"\n\n\n\nexport type Meta = { key: string, value: string }\nexport type ViewId = string\nexport type RequestId = number\nexport type EncodedAction = string\nexport type ViewState = string\n\nexport type RemoteEvent = { name: string, detail: unknown }\n\n\nexport function renderMetas(meta: Meta[]): string {\n  return meta.map(m => m.key + \": \" + m.value).join('\\n')\n}\n\nexport type Metadata = {\n  cookies?: string[]\n  // redirect?: string\n  error?: string\n  query?: string\n  events?: RemoteEvent[]\n  actions?: [ViewId, EncodedAction][],\n  pageTitle?: string\n}\n\n\nexport function toMetadata(meta: Meta[]): Metadata {\n\n  return {\n    cookies: meta.filter(m => m.key == \"Cookie\").map(m => m.value),\n    // redirect: metaValue(\"Redirect\", meta),\n    error: metaValue(\"Error\", meta),\n    query: metaValue(\"Query\", meta),\n    pageTitle: metaValue(\"PageTitle\", meta),\n    events: metaValuesAll(\"Event\", meta).map(parseRemoteEvent),\n    actions: metaValuesAll(\"Trigger\", meta).map(parseAction),\n  }\n}\n\n// viewId: meta.find(m => m.key == \"VIEW-ID\")?.value,\n\nexport function parseMetadata(input: string): Metadata {\n  let metas = takeWhileMap(parseMeta, input.trim().split(\"\\n\"))\n  return toMetadata(metas)\n}\n\n\nexport function metaValue(key: string, metas: Meta[]): string | undefined {\n  return metas.find(m => m.key == key)?.value\n}\n\nexport function metaValuesAll(key: string, metas: Meta[]): string[] {\n  return metas.filter(m => m.key == key).map(m => m.value)\n}\n\nexport type SplitMessage = {\n  command: string,\n  metas: Meta[],\n  rest: string[]\n}\n\n\nexport function splitMessage(message: string): SplitMessage {\n  let lines = message.split(\"\\n\")\n  let command: string = lines[0]\n  let metas: Meta[] = takeWhileMap(parseMeta, lines.slice(1))\n  // console.log(\"Split Metadata\", lines.length)\n  // console.log(\" [0]\", lines[0])\n  // console.log(\" [1]\", lines[1])\n  let rest = dropWhile(l => l == \"\", lines.slice(metas.length + 1))\n\n  return { command, metas, rest }\n}\n\nexport function parseMeta(line: string): Meta | undefined {\n  let match = line.match(/^(\\w+)\\: (.*)$/)\n  if (match) {\n    return {\n      key: match[1],\n      value: match[2]\n    }\n  }\n}\n\n\nexport function parseRemoteEvent(input: string): RemoteEvent {\n  let [name, data] = breakNextSegment(input)\n  return {\n    name,\n    detail: JSON.parse(data)\n  }\n}\n\nexport function parseAction(input: string): [ViewId, string] {\n  let [viewId, action] = breakNextSegment(input)\n  return [viewId, action]\n}\n\nfunction breakNextSegment(input: string): [string, string] {\n  let ix = input.indexOf('|')\n  if (ix === -1) {\n    let err = new Error(\"Bad Encoding, Expected Segment\")\n    err.message = input\n    throw err\n  }\n  return [input.slice(0, ix), input.slice(ix + 1)]\n}\n\n"
  },
  {
    "path": "client/src/response.ts",
    "content": "\nimport { ViewId, Metadata } from './message'\n\n\n\nexport type Response = {\n  meta: Metadata\n  body: ResponseBody\n}\n\nexport type ResponseBody = string\n\nexport function parseResponse(res: ResponseBody): LiveUpdate {\n  const parser = new DOMParser()\n  const doc = parser.parseFromString(res, 'text/html')\n  const css = doc.querySelector<HTMLStyleElement>(\"style\")\n  const content = doc.querySelector<HTMLElement>(\"div\")\n\n  return {\n    content: content,\n    css: css\n  }\n}\n\nexport type LiveUpdate = {\n  content: HTMLElement | null\n  css: HTMLStyleElement | null\n}\n\n\nexport class FetchError extends Error {\n  viewId: ViewId\n  body: string\n  constructor(viewId: ViewId, msg: string, body: string) {\n    super(msg)\n    this.viewId = viewId\n    this.name = \"Fetch Error\"\n    this.body = body\n  }\n}\n"
  },
  {
    "path": "client/src/sockets.ts",
    "content": "import { ActionMessage, renderActionMessage } from './action'\nimport { ResponseBody } from \"./response\"\nimport * as message from \"./message\"\nimport { ViewId, RequestId, EncodedAction, metaValue, Metadata, RemoteEvent } from \"./message\"\n\nconst protocol = window.location.protocol === 'https:' ? 'wss:' : 'ws:';\nconst defaultAddress = `${protocol}//${window.location.host}${window.location.pathname}`\n\ninterface SocketConnectionEventMap {\n  \"update\": CustomEvent<Update>;\n  \"response\": CustomEvent<Update>;\n  \"redirect\": CustomEvent<Redirect>;\n  \"trigger\": CustomEvent<Trigger>;\n  \"event\": CustomEvent<JSEvent>;\n}\n\nexport class SocketConnection {\n  socket: WebSocket\n\n  hasEverConnected: Boolean = false\n  isConnected: Boolean = false\n  reconnectDelay: number = 0\n  queue: ActionMessage[] = []\n  events: EventTarget\n\n  constructor(addr = defaultAddress) {\n    this.events = new EventTarget()\n    const sock = new WebSocket(addr)\n    this.socket = sock\n  }\n\n  connect(addr = defaultAddress, createSocket = false) {\n    const sock = createSocket ? new WebSocket(addr) : this.socket\n    this.socket = sock\n\n    function onConnectError(ev: Event) {\n      console.error(\"Connect Error\", ev)\n    }\n\n    function onSocketError(ev: Event) {\n      console.error(\"Socket Error\", ev)\n    }\n\n\n    // initial connection errors\n    sock.addEventListener('error', onConnectError)\n\n    sock.addEventListener('open', (_event) => {\n      console.log(\"Websocket Connected\")\n\n      if (this.hasEverConnected) {\n        document.dispatchEvent(new Event(\"hyp-socket-reconnect\"))\n      }\n\n      this.isConnected = true\n      this.hasEverConnected = true\n      this.reconnectDelay = 1000\n      sock.removeEventListener('error', onConnectError)\n      sock.addEventListener('error', onSocketError)\n\n      document.dispatchEvent(new Event(\"hyp-socket-connect\"))\n\n      this.runQueue()\n    })\n\n    sock.addEventListener('close', _ => {\n      console.log(\"CLOSE SOCKET\")\n      if (this.isConnected) {\n        document.dispatchEvent(new Event(\"hyp-socket-disconnect\"))\n      }\n\n      this.isConnected = false\n      sock.removeEventListener('error', onSocketError)\n\n      // attempt to reconnect in 1s\n      if (this.hasEverConnected) {\n        console.log(\"Reconnecting in \" + (this.reconnectDelay / 1000) + \"s\")\n        setTimeout(() => this.connect(addr, true), this.reconnectDelay)\n      }\n\n      sock.removeEventListener('error', onSocketError)\n    })\n\n    sock.addEventListener('message', ev => this.onMessage(ev))\n  }\n\n  async sendAction(action: ActionMessage) {\n    if (this.isConnected) {\n      let msg = renderActionMessage(action)\n      this.socket.send(msg)\n    }\n    else {\n      this.queue.push(action)\n    }\n  }\n\n  private runQueue() {\n    // send all messages queued while disconnected \n    let next: ActionMessage | undefined = this.queue.pop()\n    if (next) {\n      console.log(\"runQueue: \", next)\n      this.sendAction(next)\n      this.runQueue()\n    }\n  }\n\n\n  // full responses will never be sent over!\n  private onMessage(event: MessageEvent) {\n    let { command, metas, rest } = message.splitMessage(event.data)\n    // console.log(\"MESSAGE\", command, metas, rest)\n\n    let requestId = parseInt(requireMeta(\"RequestId\"), 0)\n\n    function requireMeta(key: string): string {\n      let val = metaValue(key, metas)\n      if (!val) throw new ProtocolError(\"Missing Required Metadata: \" + key, event.data)\n      return val\n    }\n\n    function parseResponse(rest: string[]): Update {\n      let viewId = requireMeta(\"ViewId\")\n      let action = requireMeta(\"Action\")\n      return {\n        requestId,\n        targetViewId: undefined,\n        viewId,\n        action,\n        meta: message.toMetadata(metas),\n        body: rest.join(\"\\n\"),\n      }\n    }\n\n    function parseUpdate(rest: string[]): Update {\n      let up = parseResponse(rest)\n      // add the TargetViewId\n      up.targetViewId = metaValue(\"TargetViewId\", metas)\n      return up\n    }\n\n    function parseRedirect(rest: string[]): Redirect {\n      let url = rest[0]\n      return {\n        requestId,\n        meta: message.toMetadata(metas),\n        url\n      }\n    }\n\n    function parseTrigger(rest: string[]): Trigger {\n      let { requestId, meta, viewId, action } = parseResponse(rest)\n      let [targetViewId, targetAction] = message.parseAction(requireMeta(\"Trigger\"))\n      return { requestId, meta, viewId, action, targetViewId, targetAction }\n    }\n\n    function parseEvent(rest: string[]): JSEvent {\n      let { requestId, meta, viewId, action } = parseResponse(rest)\n      let event = message.parseRemoteEvent(requireMeta(\"Event\"))\n      return { requestId, meta, viewId, action, event }\n    }\n\n\n    switch (command) {\n\n      case \"|UPDATE|\":\n        return this.dispatchEvent(new CustomEvent(\"update\", { detail: parseUpdate(rest) }))\n\n      case \"|RESPONSE|\":\n        return this.dispatchEvent(new CustomEvent(\"response\", { detail: parseResponse(rest) }))\n\n      case \"|REDIRECT|\":\n        return this.dispatchEvent(new CustomEvent(\"redirect\", { detail: parseRedirect(rest) }))\n\n      case \"|TRIGGER|\":\n        return this.dispatchEvent(new CustomEvent(\"trigger\", { detail: parseTrigger(rest) }))\n\n      case \"|EVENT|\":\n        return this.dispatchEvent(new CustomEvent(\"event\", { detail: parseEvent(rest) }))\n\n      default:\n        throw new ProtocolError(\"Unknown Server Command: \" + command, event.data)\n    }\n  }\n\n\n  // so what if they send remote events in the page? trigger, redirect, page title, etc...\n  // we aren't connected yet on a page thing\n\n  // private async waitMessage(reqId: RequestId, id: ViewId): Promise<ParsedResponse> {\n  //   return new Promise((resolve, reject) => {\n  //     const onMessage = (event: MessageEvent) => {\n  //       let data: string = event.data\n  //       let lines = data.split(\"\\n\").slice(1)  // drop the command line\n  //\n  //       let parsed = splitMetadata(lines)\n  //       let metadata: Metadata = parsed.metadata\n  //\n  //       if (!metadata.requestId) {\n  //         console.error(\"Missing RequestId!\", metadata, event.data)\n  //         return\n  //       }\n  //\n  //       if (metadata.requestId != reqId) {\n  //         // skip, it's not us!\n  //         return\n  //       }\n  //\n  //\n  //       // We have found our message. Remove the listener\n  //       this.socket.removeEventListener('message', onMessage)\n  //\n  //       // set the cookies. These happen automatically in http\n  //       metadata.cookies.forEach((cookie: string) => {\n  //         document.cookie = cookie\n  //       })\n  //\n  //       if (metadata.error) {\n  //         reject(new FetchError(id, metadata.error, parsed.rest.join('\\n')))\n  //         return\n  //       }\n  //\n  //       resolve(parsed)\n  //     }\n  //\n  //     this.socket.addEventListener('message', onMessage)\n  //     this.socket.addEventListener('error', reject)\n  //   })\n  // }\n\n  addEventListener<K extends keyof SocketConnectionEventMap>(e: K, cb: (ev: SocketConnectionEventMap[K]) => void) {\n    this.events.addEventListener(e,\n      // @ts-ignore: HACK\n      cb\n    )\n  }\n\n  dispatchEvent<K extends keyof SocketConnectionEventMap>(e: SocketConnectionEventMap[K]) {\n    this.events.dispatchEvent(e)\n  }\n\n  disconnect() {\n    this.isConnected = false\n    this.hasEverConnected = false\n    this.socket.close()\n  }\n}\n\n\nexport type Update = {\n  requestId: RequestId\n  meta: Metadata\n  viewId: ViewId\n  targetViewId?: ViewId\n  action: EncodedAction\n  body: ResponseBody\n}\n\nexport type Redirect = {\n  requestId: RequestId\n  meta: Metadata\n  url: string\n}\n\nexport type Trigger = {\n  requestId: RequestId\n  meta: Metadata\n  viewId: ViewId\n  action: EncodedAction\n  targetViewId: ViewId\n  targetAction: string\n}\n\nexport type JSEvent = {\n  requestId: RequestId\n  meta: Metadata\n  viewId: ViewId\n  action: EncodedAction\n  event: RemoteEvent\n}\n\nexport type MessageType = string\n\n\n// PARSING MESSAGE  ---------------------------------------\n\nexport class ProtocolError extends Error {\n  constructor(description: string, body: string) {\n    super(description + \"\\n\" + body)\n    this.name = \"ProtocolError\"\n  }\n}\n"
  },
  {
    "path": "client/tsconfig.json",
    "content": "{\n  \"compilerOptions\": {\n    \"outDir\": \"./dist/\",\n    \"sourceMap\": true,\n    \"noImplicitAny\": true,\n    \"module\": \"ES2020\",\n    \"target\": \"ES2020\",\n    \"lib\": [\"ES2020\",\"DOM\"],\n    \"allowJs\": true,\n    \"moduleResolution\": \"node\",\n    \"declaration\": true,\n    \"strict\": true\n    // \"skipLibCheck\": true\n    /*\"declarationMap\": true*/\n  },\n  \"include\": [\n    \"./src/**/*\",\n    \"./declarations.d.ts\"\n  ]\n}\n"
  },
  {
    "path": "client/util/live-reload.js",
    "content": "// This isn't magic. If you want custom behavior, copy and modify this however you like. \n//\n// As with any custom js, add to a single page via the `script` combinator\n//  page = do\n//     pure $ do\n//        el \"This is my page\"\n//        script \"custom.js\"\n//\n// or to the entire app by adding a script tag to your document function. See Example.App.toDocument\n//\n// Consider conditionally adding it based on ENV\nconsole.log(\"Live Reload enabled\")\n\nfunction showNotification(message) {\n  const notification = document.createElement('div');\n  notification.classList.add(\"live-reload\")\n  notification.innerHTML = message;\n  jackIn(notification.style)\n  notification.addEventListener('click', function() {\n    notification.remove()\n  })\n  document.body.appendChild(notification);\n}\n\ndocument.addEventListener(\"hyp-socket-disconnect\", () => {\n  showNotification(\"DISCONNECTED - will reload on reconnect\")\n})\n\ndocument.addEventListener(\"hyp-socket-reconnect\", () => {\n  setTimeout(() => {\n    location.reload()\n  }, 0)\n})\n\n\n// duplicate cyber style stuff here so the default live reload is fun\nfunction jackIn(style) {\n  style.position = 'fixed';\n  style.bottom = '15px';\n  style.left = '15px';\n  style.right = '15px';\n  style.backgroundColor = 'rgba(160, 63, 56, 1.0)';\n  style.color = '#fff';\n  style.borderTop = 'solid #EC6458 4px';\n  style.padding = '15px';\n  style.zIndex = '1000';\n  style.clipPath = 'polygon(0 0, 100% 0, 100% calc(100% - 16px), calc(100% - 16px) 100%, 0 100%)';\n}\n"
  },
  {
    "path": "client/webpack.config.js",
    "content": "const path = require('path');\n// var PACKAGE = require('./package.json');\n// var version = PACKAGE.version;\n\nmodule.exports = {\n  entry: \"./src/index.ts\",\n  target: \"web\",\n  devtool: \"source-map\",\n  mode: \"production\",\n  module: {\n    rules: [\n      {\n        test: /\\.tsx?$/,\n        use: 'ts-loader',\n        exclude: /node_modules/,\n      },\n    ],\n  },\n  resolve: {\n    mainFields: ['browser', 'module', 'main'],\n    extensions: ['.tsx', '.ts', '.js'],\n  },\n\n  output: {\n    // filename: `hyperbole-${version}.js`,\n    filename: \"hyperbole.js\",\n    path: path.resolve(__dirname, 'dist'),\n  },\n\n  // devServer: {\n  //   contentBase: path.join(__dirname, 'dist'),\n  //   compress: true,\n  //   port: 9000,\n  // },\n}\n\n"
  },
  {
    "path": "demo/.dockerignore",
    "content": "dist-newstyle\n.git\n"
  },
  {
    "path": "demo/App/Cache.hs",
    "content": "module App.Cache where\n\nimport Network.HTTP.Types (Header)\nimport Network.Wai.Middleware.Static\n\nclientCache :: IO Options\nclientCache = do\n  container <- initCaching PublicStaticCaching\n  -- container <- initCaching (CustomCaching customCache)\n  pure $ defaultOptions{cacheContainer = container}\n\n-- for testing if caching is working\ncustomCache :: FileMeta -> [Header]\ncustomCache (FileMeta lm etag _file) = do\n  [(\"Cache-Control\", \"no-transform,public,max-age=30\"), (\"Last-Modified\", lm), (\"Etag\", etag)]\n"
  },
  {
    "path": "demo/App/Config.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule App.Config where\n\nimport Data.Maybe (fromMaybe, isNothing)\nimport Effectful\nimport Effectful.Environment\nimport Effectful.Exception\nimport Network.HTTP.Client qualified as HTTP\nimport Network.HTTP.Client.TLS qualified as HTTPS\nimport Network.URI (parseURI)\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.Effect.OAuth2 (Config (..), Token (..))\nimport Web.Hyperbole.Effect.OAuth2 qualified as OAuth2\n\ndata App\ndata AppConfig = AppConfig\n  { endpoint :: Endpoint App\n  , manager :: HTTP.Manager\n  , oauth :: OAuth2.Config\n  , devMode :: Bool\n  }\n\ngetAppConfigEnv :: (IOE :> es, Environment :> es) => Eff es AppConfig\ngetAppConfigEnv = do\n  endpoint <- lookupEnvEndpoint \"APP_ENDPOINT\" -- default to localhost\n  manager <- HTTPS.newTlsManager\n  pure $\n    AppConfig\n      { endpoint = fromMaybe (Endpoint [uri|http://localhost:3000|]) endpoint\n      , manager\n      , oauth = dummyOAuthConfig\n      , devMode = isNothing endpoint -- in dev mode if APP_ENDPOINT is not set (localhost)\n      }\n\ntype Key = String\n\ndata ConfigError\n  = BadEnv Key\n  deriving (Show, Exception)\n\nlookupEnvEndpoint :: (Environment :> es) => Key -> Eff es (Maybe (Endpoint a))\nlookupEnvEndpoint k = do\n  mstr <- lookupEnv k\n  pure $ parseEndpoint mstr\n where\n  parseEndpoint mstr = do\n    input <- mstr\n    url <- parseURI input\n    pure $ Endpoint url\n\n-- In a real app this would be read from ENV. See OAuth2.initConfigEnv\ndummyOAuthConfig :: OAuth2.Config\ndummyOAuthConfig =\n  Config\n    { clientId = Token \"dummy client id\"\n    , clientSecret = Token \"dummy client secret\"\n    , authorize = Endpoint [uri|https://oauth-mock.mock.beeceptor.com/oauth/authorize|]\n    , token = Endpoint [uri|https://oauth-mock.mock.beeceptor.com/oauth/token/github|]\n    }\n"
  },
  {
    "path": "demo/App/Docs/Markdown.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# OPTIONS_GHC -Wno-orphans #-}\n\nmodule App.Docs.Markdown\n  ( markdocs\n  , markdump\n  , nodeToView\n  , embedFile\n  ) where\n\nimport App.Docs.Snippet\nimport App.Route\nimport CMark\nimport Data.Char (isSpace)\nimport Data.Set\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Data.Text.IO qualified as T\nimport Example.Colors (magenta)\nimport Example.Style qualified as Style\nimport Example.Style.Cyber qualified as Cyber\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\nimport Web.Atomic.CSS\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.HyperView.Input (route)\nimport Web.Hyperbole.Route\nimport Web.Hyperbole.View\n\nmarkdocs :: Text -> View c ()\nmarkdocs md = do\n  nodeToView $ commonmarkToNode [] $ cs md\n\nmarkdump :: Text -> View c ()\nmarkdump md = do\n  code $ cs $ show $ commonmarkToNode [] $ cs md\n\nnodeToView :: Node -> View c ()\nnodeToView (Node _mpos typ childs) = do\n  let inner = mapM_ nodeToView childs\n  case typ of\n    -- DOCUMENT -> mapM nodeToView childs\n    -- THEMATIC_BREAK -> _\n    -- PARAGRAPH -> _\n    -- BLOCK_QUOTE -> _\n    -- HTML_BLOCK Text -> _\n    -- CUSTOM_BLOCK OnEnter OnExit -> _\n    -- CODE_BLOCK Info Text -> _\n    -- HEADING Level -> _\n    -- LIST ListAttributes -> _\n    -- ITEM -> _\n    -- TEXT Text -> _\n    -- SOFTBREAK -> _\n    -- LINEBREAK -> _\n    -- HTML_INLINE Text -> _\n    -- CUSTOM_INLINE OnEnter OnExit -> _\n    -- CODE Text -> _\n    -- EMPH -> _\n    -- STRONG -> _\n    -- LINK url title -> _\n    -- IMAGE url title -> _\n    PARAGRAPH -> el inner\n    TEXT t -> text t\n    CODE t -> do\n      inlineCode t\n    HEADING lvl ->\n      el ~ bold . headerLevel lvl $ inner\n    LINK url _title ->\n      case matchRoute @AppRoute (path url) of\n        Nothing -> do\n          case parseURIReference (cs url) of\n            Nothing -> text $ \"INVALID URI: \" <> url\n            Just u ->\n              link u ~ Style.link @ att \"target\" \"_blank\" $ inner\n        Just r ->\n          route r ~ Style.link $ inner\n    LIST (ListAttributes ORDERED_LIST _ _ _) ->\n      tag \"ol\" ~ list Decimal . pad (L 32) $ inner\n    LIST (ListAttributes BULLET_LIST _ _ _) ->\n      tag \"ul\" ~ list Disc . pad (L 32) $ inner\n    ITEM -> tag \"li\" inner\n    DOCUMENT -> inner\n    CODE_BLOCK _info t ->\n      snippet $ raw t\n    BLOCK_QUOTE -> el ~ Cyber.quote $ inner\n    HTML_BLOCK t -> raw t\n    SOFTBREAK -> inner\n    EMPH -> tag' True \"span\" ~ italic $ inner\n    STRONG -> tag' True \"span\" ~ bold $ inner\n    x ->\n      -- inner\n      raw $ cs $ show x\n where\n  headerLevel lvl =\n    case lvl of\n      1 -> fontSize 24\n      2 -> fontSize 20\n      _ -> fontSize 16\n\nhackageDocsURI :: URI\nhackageDocsURI = [uri|https://hackage-content.haskell.org/package/hyperbole/docs/Web-Hyperbole.html|]\n\ninlineCode :: Text -> View c ()\ninlineCode cd\n  | cd `elem` typeKeywords = linkSymbolDocs cd typeFrag ~ color hackageSymbolColor\n  | cd `elem` valueKeywords = linkSymbolDocs cd valFrag ~ color hackageSymbolColor\n  | otherwise = tag' True \"code\" ~ color magenta $ text cd\n where\n  typeFrag t = \"#t:\" <> cs t\n  valFrag v = \"#v:\" <> cs v\n\n  hackageSymbolColor :: HexColor\n  hackageSymbolColor = \"#9e358f\"\n\nlinkSymbolDocs :: Text -> (Text -> String) -> View c ()\nlinkSymbolDocs sym frag = do\n  link (hackageDocsURI{uriFragment = frag sym}) @ att \"target\" \"_blank\" $ do\n    tag' True \"code\" $ text sym\n\ntypeKeywords :: Set Text\ntypeKeywords =\n  [ \"Page\"\n  , \"View\"\n  , \"HyperView\"\n  , \"ViewId\"\n  , \"ViewAction\"\n  , \"ViewState\"\n  , \"Action\"\n  , \"Hyperbole\"\n  , \"Effect\"\n  , \"Query\"\n  , \"Session\"\n  , \"Require\"\n  , \"Client\"\n  , \"Request\"\n  , \"Document\"\n  , \"Path\"\n  , \"Route\"\n  , \"Eff\"\n  , \"Page\"\n  , \"Response\"\n  , \"FromForm\"\n  , \"Validated\"\n  , \"Concurrency\"\n  , \"Replace\"\n  , \"Drop\"\n  ]\n\nvalueKeywords :: Set Text\nvalueKeywords =\n  [ \"context\"\n  , \"update\"\n  , \"form\"\n  , \"validate\"\n  , \"hyper\"\n  , \"request\"\n  , \"viewId\"\n  , \"viewState\"\n  , \"trigger\"\n  , \"target\"\n  , \"hyperState\"\n  , \"runPage\"\n  , \"document\"\n  , \"routeRequest\"\n  , \"matchRoute\"\n  , \"liveApp\"\n  , \"pushUpdate\"\n  , \"onLoad\"\n  , \"session\"\n  , \"query\"\n  , \"setQuery\"\n  , \"setParam\"\n  , \"param\"\n  , \"modifyQuery\"\n  , \"saveSession\"\n  , \"deleteSession\"\n  , \"quickStartDocument\"\n  , \"search\"\n  , \"loading\"\n  , \"whenLoading\"\n  , \"dropdown\"\n  , \"option\"\n  , \"button\"\n  , \"onClick\"\n  , \"onKeyDown\"\n  , \"onKeyUp\"\n  , \"onMouseEnter\"\n  , \"onMouseLeave\"\n  , \"onInput\"\n  ]\n\nembedFile :: FilePath -> Q Exp\nembedFile p = do\n  addDependentFile p\n  lns :: [Text] <- runIO $ T.lines <$> T.readFile p\n  exps :: [Exp] <- traverse expandLine lns\n  e :: Exp <- listE (fmap pure exps)\n  [|T.unlines $(pure e)|]\n\nexpandLine :: Text -> Q Exp\nexpandLine l = do\n  let whitespace = T.takeWhile isSpace l\n  case parseLineEmbed l of\n    Just (mn, tld) -> do\n      e <- embedSource' mn (isTopLevel tld) (isCurrentDefinition tld)\n      [|T.stripEnd $ T.unlines $ fmap (whitespace <>) $(pure e)|]\n    Nothing -> do\n      t <- expandText l\n      lift t\n\nexpandText :: (MonadFail m) => Text -> m Text\nexpandText t = do\n  let segs = T.splitOn \"[[\" t\n  es :: [Text] <- mapM checkLink segs\n  pure $ mconcat es\n where\n  checkLink :: (MonadFail m) => Text -> m Text\n  checkLink l = do\n    case T.breakOn \"]]\" l of\n      (txt, \"\") -> pure txt\n      (lnk, rest) -> do\n        mdlnk <- routeLink lnk\n        pure $ mdlnk <> T.dropWhile (== ']') rest\n\n  routeLink :: (MonadFail m) => Text -> m Text\n  routeLink l =\n    case matchRoute @AppRoute (path l) of\n      Nothing -> error $ \"Could not find page link: \" <> cs l <> \" \" <> show (path l)\n      Just r -> pure $ \"[\" <> routeTitle r <> \"](\" <> uriToText (routeUri r) <> \")\"\n"
  },
  {
    "path": "demo/App/Docs/Page.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule App.Docs.Page\n  ( PageAnchor (..)\n  , sourceLink\n  , example\n  , example'\n  , section\n  , section'\n  , camelTitle\n  , Cyber.embed\n  , Cyber.quote\n  ) where\n\nimport App.Docs.Snippet (ModuleSource (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Example.Colors (AppColor (..))\nimport Example.Style qualified as Style\nimport Example.Style.Cyber qualified as Cyber\nimport Text.Casing (fromHumps, toWords)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.URI\n\nclass PageAnchor n where\n  pageAnchor :: n -> Text\n  default pageAnchor :: n -> Text\n  pageAnchor = T.toLower . T.replace \" \" \"-\" . sectionTitle\n\n  sectionTitle :: n -> Text\n  default sectionTitle :: (Show n) => n -> Text\n  sectionTitle = camelTitle\n\n  navEntry :: n -> Text\n  default navEntry :: n -> Text\n  navEntry = sectionTitle\n\n  subnav :: [n]\n  default subnav :: (Enum n, Bounded n) => [n]\n  subnav = [minBound .. maxBound]\n\ninstance PageAnchor () where\n  subnav = []\n\ncamelTitle :: (Show a) => a -> Text\ncamelTitle = cs . toWords . fromHumps . show\n\n-- Sections ----------------------------------------------------------------------\n\nsourceLink :: Path -> View c ()\nsourceLink p =\n  link sourceUrl ~ fontSize 14 @ att \"target\" \"_blank\" $ do\n    text \"</> Source\"\n where\n  sourceUrlBase = [uri|https://github.com/seanhess/hyperbole/blob/main/demo/|]\n  sourceUrl = sourceUrlBase ./. p\n\nexample :: ModuleSource -> View c () -> View c ()\nexample (ModuleSource e) = example' (path $ cs e)\n\nexample' :: Path -> View c () -> View c ()\nexample' p cnt = do\n  el ~ stack . Cyber.font $ do\n    col ~ Cyber.embed $ cnt\n    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\n\n-- section :: AppRoute -> View c () -> View c ()\n-- section r = section' (routeTitle r)\n\nsection' :: Text -> View c () -> View c ()\nsection' t cnt = do\n  tag \"section\" ~ gap 10 . flexCol $ do\n    row $ do\n      el ~ bold . fontSize 28 . Cyber.font . Style.uppercase $ text t\n    cnt\n\nsection :: (PageAnchor n) => n -> View c () -> View c ()\nsection n =\n  section' (sectionTitle n)\n    @ att \"id\" (pageAnchor n)\n\n-- type Fragment = String\n--\n-- hackage :: Fragment -> Text -> View c ()\n-- hackage uriFragment txt = do\n--   let docs = [uri|https://hackage-content.haskell.org/package/hyperbole/docs/Web-Hyperbole.html|]\n--   link docs{uriFragment} @ att \"target\" \"_blank\" ~ Style.link $ do\n--     el ~ iconInline $ do\n--       Icon.bookOpen\n--       text txt\n"
  },
  {
    "path": "demo/App/Docs/Snippet.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Docs.Snippet where\n\nimport Control.Monad (unless)\nimport Data.Char (isSpace)\nimport Data.List qualified as L\nimport Data.String (IsString)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Data.Text.IO qualified as T\nimport Language.Haskell.TH\nimport Language.Haskell.TH.Syntax\nimport System.Directory (doesFileExist, getCurrentDirectory)\nimport System.FilePath (normalise, (</>))\nimport Web.Atomic.CSS\nimport Web.Hyperbole.View\n\nsnippet :: View c () -> View c ()\nsnippet cnt = do\n  tag' True \"pre\" ~ bg (HexColor \"#F2F2F3\") $ do\n    tag' True \"code\" @ class_ \"language-haskell\" $ do\n      cnt\n\ncodeblock :: Text -> View c ()\ncodeblock t =\n  tag' True \"pre\" ~ monoline $ do\n    tag' True \"code\" $ do\n      raw t\n where\n  monoline =\n    utility\n      \"monoline\"\n      [ \"line-height\" :. \"1\"\n      ]\n\nrawMulti :: [Text] -> View c ()\nrawMulti = raw . T.stripEnd . T.unlines\n\nembedLines :: FilePath -> Int -> Int -> Q Exp\nembedLines path start end = do\n  addDependentFile path\n  contents <- runIO (T.readFile path)\n  let selected =\n        T.unlines\n          . take (end - start + 1)\n          . drop (start - 1)\n          . T.lines\n          $ contents\n  lift (T.unpack selected)\n\nnewtype TopLevelDefinition = TopLevelDefinition Text\n  deriving newtype (Show, Eq, IsString)\n\nnewtype SourceCode = SourceCode {lines :: [Text]}\n\nnewtype ModuleName = ModuleName Text\n  deriving newtype (Show, Eq, IsString)\n\nmodulePath :: ModuleName -> FilePath\nmodulePath (ModuleName mn) = cs $ \"demo/\" <> T.replace \".\" \"/\" mn <> \".hs\"\n\n{- | A top-level definition as text\n\n> snippet $(topLevel \"demo/Example/Page/Concurrency.hs\" \"instance (Debug :> es) => HyperView Polling\")\n-}\nembedTopLevel :: ModuleName -> TopLevelDefinition -> Q Exp\nembedTopLevel mn tld = do\n  embedSource mn (isTopLevel tld) (isCurrentDefinition tld)\n\nembedSource :: ModuleName -> (Text -> Bool) -> (Text -> Bool) -> Q Exp\nembedSource mn isStart isCurrent = do\n  e <- embedSource' mn isStart isCurrent\n  [|T.unlines $(pure e)|]\n\nembedSource' :: ModuleName -> (Text -> Bool) -> (Text -> Bool) -> Q Exp\nembedSource' mn isStart isCurrent = do\n  path <- runIO $ localFile $ modulePath mn\n  addDependentFile path\n  s <- runIO $ readSourceCode path\n  let lns = selectLines isStart isCurrent s\n  case lns of\n    [] -> fail $ \"Missing embed in: \" ++ show mn\n    _ -> lift lns\n\nreadSnippet :: FilePath -> TopLevelDefinition -> IO [Text]\nreadSnippet path tld = do\n  s <- readSourceCode path\n  pure $ findTopLevel tld s\n\nreadSourceCode :: FilePath -> IO SourceCode\nreadSourceCode path = SourceCode . T.lines <$> T.readFile path\n\n-- returns lines of a top-level definition\nfindTopLevel :: TopLevelDefinition -> SourceCode -> [Text]\nfindTopLevel tld =\n  selectLines (isTopLevel tld) (isCurrentDefinition tld)\n\n-- isBlankLine line = T.null $ T.strip line\n\nisCurrentDefinition :: TopLevelDefinition -> Text -> Bool\nisCurrentDefinition tld line =\n  isTopLevel tld line || not (isFullyOutdented line)\n\nisTopLevel :: TopLevelDefinition -> Text -> Bool\nisTopLevel (TopLevelDefinition def) line =\n  if \"^\" `T.isPrefixOf` def\n    then T.isPrefixOf (T.drop 1 def) line\n    else T.isPrefixOf def $ T.dropWhile (== ' ') line\n\nselectLines :: (Text -> Bool) -> (Text -> Bool) -> SourceCode -> [Text]\nselectLines isStart isCurrent s =\n  let rest = dropWhile (not . isStart) s.lines\n   in dropWhileEnd isEmpty $ takeWhile isCurrent rest\n where\n  isEmpty = T.null\n\ndropWhileEnd :: (a -> Bool) -> [a] -> [a]\ndropWhileEnd p as =\n  reverse $ dropWhile p $ reverse as\n\nisFullyOutdented :: Text -> Bool\nisFullyOutdented line =\n  case cs (T.take 1 line) of\n    \"\" -> False\n    [c] -> not $ isSpace c\n    _ -> False\n\n-- #EMBED Example.Docs.Interactive instance HyperView Titler\nparseLineEmbed :: Text -> Maybe (ModuleName, TopLevelDefinition)\nparseLineEmbed l = do\n  rest <- T.stripPrefix \"#EMBED \" (T.stripStart l)\n  (mn : tld) <- pure $ T.words rest\n  pure (ModuleName mn, TopLevelDefinition $ T.unwords tld)\n\n-- start with a relative OR absolute path, end up with a path to the file\n-- works with any working directory\nlocalFile :: FilePath -> IO FilePath\nlocalFile p = do\n  current <- getCurrentDirectory\n  let lpath = addRelativeDemo current $ stripDir \"demo\" $ stripDir current p\n  b <- doesFileExist lpath\n  unless b $ do\n    fail $ \"Could not find file: \" <> show lpath <> \" in working dir: \" <> current\n  pure lpath\n where\n  addRelativeDemo wd rp\n    | \"demo\" `L.isSuffixOf` wd = rp\n    | otherwise = \"demo\" </> rp\n\nstripDir :: FilePath -> FilePath -> FilePath\nstripDir dir p =\n  maybe\n    p\n    (dropWhile (== '/'))\n    (L.stripPrefix dir p)\n\nnewtype ModuleSource = ModuleSource FilePath\n  deriving newtype (Show, Eq, IsString)\n\nmoduleSource :: Q Exp\nmoduleSource = do\n  loc <- location\n  let path = normalise $ loc_filename loc\n  fp <- runIO $ localFile path\n  lift fp\n\nmoduleSourceNamed :: ModuleName -> Q Exp\nmoduleSourceNamed mn = do\n  fp <- runIO $ localFile $ modulePath mn\n  lift fp\n"
  },
  {
    "path": "demo/App/Docs.hs",
    "content": "module App.Docs\n  ( module App.Docs.Markdown\n  , module App.Docs.Page\n  , module App.Docs.Snippet\n  ) where\n\nimport App.Docs.Markdown\nimport App.Docs.Page\nimport App.Docs.Snippet\n"
  },
  {
    "path": "demo/App/Page/Application.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Application where\n\nimport App.Docs\nimport App.Route (AppRoute (Application))\nimport Effectful\nimport Example.CSS.External qualified as External\nimport Example.CSS.Transitions as Transitions\nimport Example.Interactivity.Events as Events\nimport Example.View.Layout\nimport Web.Hyperbole\n\ndata Sections\n  = LiveApp\n  | Document\n  | Pages\n  | TypeSafeRoutes\n  | RunningEffects\n  deriving (Eq, Generic, Show, Enum, Bounded, PageAnchor)\n\npage :: (Hyperbole :> es) => Page es '[Animate, External.Items, Boxes]\npage = do\n  pure $ layoutSubnav @Sections Application $ do\n    section LiveApp $ do\n      markdocs $(embedFile \"docs/app-live.md\")\n\n    section Document $ do\n      markdocs $(embedFile \"docs/app-document.md\")\n\n    section Pages $ do\n      --\n      markdocs $(embedFile \"docs/app-pages.md\")\n\n    section TypeSafeRoutes $ do\n      markdocs $(embedFile \"docs/app-routes.md\")\n\n    section RunningEffects $ do\n      markdocs $(embedFile \"docs/app-effects.md\")\n"
  },
  {
    "path": "demo/App/Page/CSS.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.CSS where\n\nimport App.Docs\nimport App.Route (AppRoute (CSS))\nimport Effectful\nimport Example.CSS.External qualified as External\nimport Example.CSS.Loading as Loading\nimport Example.CSS.Tooltips as Tooltips\nimport Example.CSS.Transitions as Transitions\nimport Example.Docs.CSS qualified as CSS\nimport Example.Interactivity.Events as Events\nimport Example.View.Layout\nimport Example.View.Loader as Loader\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.HyperView.Types (Root (..))\nimport Web.Hyperbole.Page (subPage)\n\ndata CSSExample\n  = Factoring\n  | Transitions\n  | Tooltips\n  | Loading\n  | External\n  deriving (Eq, Generic, Show, Enum, Bounded)\ninstance PageAnchor CSSExample where\n  sectionTitle = \\case\n    Factoring -> \"Atomic CSS\"\n    Transitions -> \"CSS Transitions\"\n    Tooltips -> \"Tooltips\"\n    Loading -> \"Loading\"\n    External -> \"External Stylesheets\"\n\npage :: (Hyperbole :> es) => Page es '[Animate, External.Items, Boxes, Loader]\npage = do\n  ext <- subPage External.page\n  pure $ layoutSubnav @CSSExample CSS $ do\n    style Loader.css\n    section Factoring $ do\n      markdocs $(embedFile \"docs/atomic.md\")\n\n      CSS.example ~ embed\n\n    section Transitions $ do\n      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.\"\n      snippet $ do\n        raw $(embedTopLevel \"Example.CSS.Transitions\" \"viewSmall\")\n        raw \"\\n\"\n        raw $(embedTopLevel \"Example.CSS.Transitions\" \"viewBig\")\n      example Transitions.source $ hyper Animate viewSmall\n\n    section Tooltips $ do\n      markdocs \"For immediate feedback, create interactivity via Atomic CSS whenever possible.\"\n      example Tooltips.source tooltips\n\n    section Loading $ do\n      markdocs \"Use `whenLoading` to provide feedback while an `Action` is being processed\"\n      snippet $ do\n        raw $(embedTopLevel \"Example.CSS.Loading\" \"viewLoaders\")\n\n      example $(moduleSourceNamed \"Example.CSS.Loading\") $ do\n        hyper Loader $ viewLoaders \"...\"\n\n    section External $ do\n      markdocs \"You can opt-out of Atomic CSS and use external classes with `class_`\"\n      snippet $ do\n        raw $(embedTopLevel \"Example.CSS.External\" \"page\")\n      snippet $ do\n        raw $(embedTopLevel \"Example.CSS.External\" \"itemsView\")\n      example External.source $ do\n        runViewContext Root () ext\n"
  },
  {
    "path": "demo/App/Page/Concurrency.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule App.Page.Concurrency where\n\nimport App.Docs\nimport App.Route qualified as Route\nimport Control.Monad (forM_)\nimport Effectful\nimport Example.Concurrency.LazyLoading as Lazy\nimport Example.Concurrency.Overlap as Overlap\nimport Example.Concurrency.Polling as Polling\nimport Example.Concurrency.Progress as Progress\nimport Example.Concurrency.Tasks\nimport Example.Effects.Debug\nimport Example.Push qualified as Push\nimport Example.Style.Cyber (btn, font)\nimport Example.View.Layout (layoutSubnav)\nimport Example.View.Loader as Loader\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Section\n  = Concurrency\n  | OverlappingRequests\n  | LazyLoading\n  | Polling\n  | PushUpdates\n  deriving (Show, Eq, Enum, Bounded, PageAnchor)\n\npage :: (Hyperbole :> es, Debug :> es) => Page es '[Poller, LazyData, Progress, Push.Tasks, OverlapDrop, OverlapReplace, LazyAll]\npage = do\n  pure $ layoutSubnav @Section Route.Concurrency $ do\n    style Loader.css\n    section Concurrency $ do\n      markdocs \"While individual `HyperView`s can only have one update in progress at a time, multiple `HyperView`s can overlap updates without issue\"\n      example Progress.source ~ font $ do\n        hyper (Progress 1) $ viewProgressLoad 6\n        hyper (Progress 2) $ viewProgressLoad 4\n        hyper (Progress 3) $ viewProgressLoad 2\n    -- hyper (Progress 4 200) viewProgressLoad\n    -- hyper (Progress 5 250) viewProgressLoad\n\n    section OverlappingRequests $ do\n      markdocs $(embedFile \"docs/concurrency-overlap.md\")\n\n      example $(moduleSourceNamed \"Example.Concurrency.Overlap\") $ do\n        hyper OverlapDrop $ viewTimeDrop Nothing\n        hyper OverlapReplace $ viewTimeReplace Nothing\n\n    section LazyLoading $ do\n      markdocs \"Instead of preloading everything in our `Page`, a `HyperView` can load itself using `onLoad`\"\n      snippet $ raw $(embedTopLevel \"Example.Concurrency.LazyLoading\" \"viewTaskLoad\")\n      example Lazy.source $ do\n        hyper LazyAll viewLazyAll\n\n    section Polling $ do\n      markdocs \"By including an `onLoad` in every view update, we can poll the server after a given delay\"\n      snippet $ raw $(embedTopLevel \"Example.Concurrency.Polling\" \"viewPoll\")\n      example Polling.source $ do\n        hyper Poller viewInit\n\n    section PushUpdates $ do\n      markdocs \"Actions can call `pushUpdate` to send an intermediate update to the view. This can be simpler than polling.\"\n      snippet $ raw $(embedTopLevel \"Example.Push\" \"update\")\n      example Push.source $ do\n        hyper Push.Tasks $ Push.taskView 0\n\ndata LazyAll = LazyAll\n  deriving (Generic, ViewId)\n\ninstance HyperView LazyAll es where\n  data Action LazyAll\n    = ReloadAll\n    deriving (Generic, ViewAction)\n\n  type Require LazyAll = '[LazyData]\n\n  update _ = do\n    pure viewLazyAll\n\nviewLazyAll :: View LazyAll ()\nviewLazyAll = do\n  col ~ gap 10 $ do\n    row ~ flexWrap Wrap . font . gap 10 $ do\n      forM_ pretendTasks $ \\taskId -> do\n        el ~ border 1 . width 120 . pad 5 $ do\n          hyper (LazyData taskId) viewTaskLoad\n    row $ button ReloadAll ~ btn $ \"Reload\"\n"
  },
  {
    "path": "demo/App/Page/Examples.hs",
    "content": "module App.Page.Examples where\n\nimport App.Docs\nimport App.Route as Route\nimport Example.Style as Style (link)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[]\npage = do\n  pure $ layout (Examples OtherExamples) $ do\n    section' \"Data Lists\" $ do\n      col ~ gap 10 $ do\n        card (Data SortableTable) \"Sort by column, demonstrates view functions\"\n        card (Data Autocomplete) \"Incremental search using only hyperbole\"\n        card (Data Filter) \"Faceted search, live filtering of lists  \"\n        card (Data LoadMore) \"Progressively load more items\"\n\n    section' \"UI Demos\" $ do\n      col ~ gap 10 $ do\n        card (Examples Tags) $ markdocs \"Add and remove \\\"tags\\\" with an `<input>`\"\n        card (Examples Chat) \"Demonstrates server pushes and concurrency. Open in multiple tabs\"\n        card (Examples Scrollbars) \"Layouts with internal scrollbars\"\n\n    section' \"Other Features\" $ do\n      card (Examples OAuth2) \"Demonstration of OAuth2\"\n\n    section' \"Reference Implementations\" $ do\n      card (Examples Todos) \"using Atomic CSS\"\n      card (Examples TodosCSS) \"using external classes\"\n where\n  card r cnt = do\n    row ~ gap 5 $ do\n      route r ~ Style.link $ do\n        text $ routeTitle r\n      el $ text \"-\"\n      el cnt\n\n-- cardBtn :: (Styleable h) => CSS h -> CSS h\n-- cardBtn =\n--   bgAnimated\n--     . bgGradient White\n--     . hover bgzero\n--     . clip 10\n--     . shadow ()\n--\n-- grid :: (Styleable h) => CSS h -> CSS h\n-- grid =\n--   utility\n--     \"grid-ex\"\n--     [ \"display\" :. \"grid\"\n--     , \"grid-template-columns\" :. \"repeat(auto-fit, minmax(200px, 1fr))\"\n--     ]\n--\n-- tile :: (Styleable h) => CSS h -> CSS h\n-- tile =\n--   utility\n--     \"tile\"\n--     [ \"aspect-ratio\" :. \"16 / 9\"\n--     ]\n\n-- section Effectful $ do\n--   markdocs $(embedFile \"docs/effectful.md\")\n--   example SideEffects.source $ do\n--     hyper Titler titleView\n--\n-- section Other $ do\n--   markdocs $(embedFile \"docs/effects-other.md\")\n--   example SideEffects.source $ do\n--     hyper SlowReader $ messageView \"...\"\n--\n-- section Custom $ do\n--   markdocs $(embedFile \"docs/effects-custom.md\")\n"
  },
  {
    "path": "demo/App/Page/Forms.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Forms where\n\nimport App.Docs\nimport App.Route\nimport Example.FormSimple (AddContact (..))\nimport Example.FormSimple qualified as FormSimple\nimport Example.FormValidation (Signup (..))\nimport Example.FormValidation qualified as FormValidation\nimport Example.View.Layout\nimport Web.Hyperbole\n\ndata Sections\n  = BasicForms\n  | Validation\n  deriving (Generic, Show, Bounded, Enum, PageAnchor)\n\npage :: (Hyperbole :> es) => Page es '[Signup, AddContact]\npage = do\n  pure $ layoutSubnav @Sections (Forms FormSimple) $ do\n    section BasicForms $ do\n      markdocs $(embedFile \"docs/forms-simple.md\")\n\n      example FormSimple.source $ do\n        hyper AddContact FormSimple.formView'\n\n    section Validation $ do\n      markdocs $(embedFile \"docs/forms-validated.md\")\n\n      example FormValidation.source $ do\n        --\n        hyper Signup $ FormValidation.formView genFields\n"
  },
  {
    "path": "demo/App/Page/HyperboleEffect.hs",
    "content": "module App.Page.HyperboleEffect where\n\nimport App.Route as Route hiding (Response, UserId)\nimport App.Docs\nimport Effectful\nimport Example.Errors (Errors (..), Users (..), viewCustom, viewExceptions, viewKnownUsers, viewSearchUsers)\nimport Example.Errors qualified as Errors\nimport Example.Requests (CheckRequest (..), ControlClient (..), ControlResponse (..))\nimport Example.Requests qualified as Requests\nimport Example.View.Layout (layoutSubnav)\nimport Web.Hyperbole hiding (Response)\n\ndata Sections\n  = Requests\n  | Response\n  | ExceptionHandling\n  | EdgeCases\n  | HandleInViews\n  | CustomErrorViews\n  deriving (Show, Enum, Bounded, PageAnchor)\n\npage :: (Hyperbole :> es) => Page es '[CheckRequest, ControlResponse, ControlClient, Errors, Users]\npage = do\n  r <- request\n  pure $ layoutSubnav @Sections Route.HyperboleEffect $ do\n    section Requests $ do\n      markdocs \"The `Hyperbole` `Effect` allows us to skip the normal update cycle to directly access the `Request` or manipulate the `Client`\"\n      example Requests.source $ do\n        hyper CheckRequest $ Requests.viewRequest r\n\n      example Requests.source $ do\n        hyper ControlClient Requests.viewClient\n\n    section Response $ do\n      el \"It also allows us to directly affect the response and the javascript client\"\n      example Requests.source $ hyper ControlResponse Requests.responseView\n\n    section ExceptionHandling $ do\n      el \"Any uncaught exceptions thrown from a handler will be displayed in a bright red box inline in the corresponding HyperView\"\n      example Errors.source $ do\n        hyper Exceptions viewExceptions\n\n    section EdgeCases $ do\n      el \"You can use the same mechanism to exit execution early and display an application error to handle edge cases\"\n      example Errors.source $ do\n        hyper KnownUsers viewKnownUsers\n\n    section HandleInViews $ do\n      el \"Handle any expected errors in your view function, by making it accept a Maybe or Either\"\n      example Errors.source $ do\n        hyper SearchUsers viewSearchUsers\n\n    section CustomErrorViews $ do\n      el \"You can also exit execution early and display a custom view from application code or from caught execptions\"\n      example Errors.source $ do\n        hyper Customs viewCustom\n"
  },
  {
    "path": "demo/App/Page/Hyperviews.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Hyperviews where\n\nimport App.Docs\nimport App.Route qualified as Route (AppRoute (..))\nimport Example.Counter (Counter (..))\nimport Example.Docs.MultiView qualified as Multi\nimport Example.Docs.Nesting qualified as Nesting\nimport Example.Docs.UniqueViewId qualified as UniqueViewId\nimport Example.Push as Push\nimport Example.Simple (Message (..))\nimport Example.Trigger as Trigger\nimport Example.View.Layout (layoutSubnav)\nimport Web.Hyperbole\nimport Web.Hyperbole.HyperView.Types (Root (..))\nimport Web.Hyperbole.Page (subPage)\n\ndata HyperSectuions\n  = IndependentUpdates\n  | UniqueViewid\n  | Nesting\n  | TargetingOtherHyperviews\n  deriving (Show, Enum, Bounded, PageAnchor)\n\npage :: (Hyperbole :> es) => Page es '[Counter, Message, UniqueViewId.Item, Nesting.ItemList, Targeted, Controls, Tasks]\npage = do\n  mlt <- subPage Multi.page\n  uvd <- subPage UniqueViewId.page\n  nst <- subPage Nesting.page\n  pure $ layoutSubnav @HyperSectuions Route.Hyperviews $ do\n    section IndependentUpdates $ do\n      markdocs $(embedFile \"docs/hyperviews-multi.md\")\n      example $(moduleSourceNamed \"Example.Docs.MultiView\") $ do\n        runViewContext Root () mlt\n\n    section UniqueViewid $ do\n      markdocs $(embedFile \"docs/hyperviews-unique.md\")\n      example $(moduleSourceNamed \"Example.Docs.UniqueViewId\") $ do\n        runViewContext Root () uvd\n\n    section Nesting $ do\n      markdocs $(embedFile \"docs/hyperviews-nesting.md\")\n\n      example $(moduleSourceNamed \"Example.Docs.Nesting\") $ do\n        runViewContext Root () nst\n\n    section TargetingOtherHyperviews $ do\n      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:\"\n      example Trigger.source $ do\n        hyper Targeted $ targetedView \"...\"\n\n      markdocs \"Use `trigger` to tell another `HyperView` to run an action\"\n      snippet $ do\n        raw $(embedTopLevel \"Example.Trigger\" \"instance HyperView Controls\")\n\n      example Trigger.source $ do\n        hyper Controls controlView\n\n      markdocs \"You can use `target` in a `View` to use `Action`s from another `HyperView`\"\n      snippet $ do\n        raw $(embedTopLevel \"Example.Trigger\" \"targetView\")\n\n      example Trigger.source $ do\n        hyper Controls targetView\n\n      markdocs \"Alternatively, you can use `pushUpdate` to directly update another view:\"\n\n      example Push.source $ do\n        hyper Tasks $ taskView 0\n"
  },
  {
    "path": "demo/App/Page/Interactivity.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Interactivity where\n\nimport App.Docs\nimport App.Route hiding (Javascript)\nimport Example.Interactivity.Events\nimport Example.Interactivity.Inputs\nimport Example.Javascript as Javascript\nimport Example.View.Layout\nimport Web.Hyperbole\n\ndata Sections\n  = Inputs\n  | Events\n  | Javascript\n  deriving (Show, Bounded, Enum, PageAnchor)\n\npage :: (Hyperbole :> es) => Page es '[Boxes, JBoxes, Message, TryEvents, Dropper]\npage = do\n  pure $ layoutSubnav @Sections Interactivity $ do\n    -- NOTE: only include javascript on the pages you need it\n    script \"custom.js\"\n\n    section Inputs $ do\n      markdocs $(embedFile \"docs/interactivity-inputs.md\")\n      example $(moduleSourceNamed \"Example.Interactivity.Inputs\") $ hyper Dropper (selectPlanet Nothing)\n\n    section Events $ do\n      markdocs $(embedFile \"docs/interactivity-events.md\")\n      example $(moduleSourceNamed \"Example.Interactivity.Events\") $ hyper TryEvents (viewEvents \"\")\n\n      markdocs $(embedFile \"docs/interactivity-events2.md\")\n      example $(moduleSourceNamed \"Example.Interactivity.Events\") $ hyper Boxes (viewBoxes Nothing)\n\n    section Javascript $ do\n      markdocs $(embedFile \"docs/interactivity-javascript.md\")\n      example Javascript.source $ do\n        hyper JBoxes $ viewJBoxes Nothing\n\n      markdocs $(embedFile \"docs/interactivity-pushevent.md\")\n      example Javascript.source $ do\n        hyper Message viewMessage\n"
  },
  {
    "path": "demo/App/Page/Intro/Basics.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Intro.Basics where\n\nimport App.Docs\nimport App.Route\nimport Data.String.Interpolate (i)\nimport Example.Counter (Counter)\nimport Example.Docs.Interactive qualified as Interactive\nimport Example.Docs.ViewFunctions qualified as ViewFunctions\nimport Example.Simple as Simple\nimport Example.View.Layout (layoutSubnav)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.HyperView.Types (Root (..))\nimport Web.Hyperbole.Page (subPage)\n\ndata Basics\n  = GetRunning\n  | HtmlViews\n  | Interactive\n  deriving (Show, Enum, Bounded)\n\ninstance PageAnchor Basics where\n  sectionTitle Interactive = \"Interactive HyperViews\"\n  sectionTitle a = camelTitle a\n\n  navEntry Interactive = \"HyperViews\"\n  navEntry a = sectionTitle a\n\npage :: (Hyperbole :> es) => Page es '[Message, Counter, ViewFunctions.Message]\npage = do\n  int <- subPage Interactive.page\n  -- mlt <- subPage Multi.page\n  pure $ layoutSubnav @Basics Basics $ do\n    section GetRunning getRunning\n    section HtmlViews htmlViews\n\n    -- section Styles $ do\n    --   markdocs $(embedFile \"docs/atomic.md\")\n    --   CSS.example ~ embed\n    --   markdocs \"See [Styles](/css) for more info\"\n\n    section Interactive $ do\n      markdocs $(embedFile \"docs/hyperviews-intro.md\")\n\n      example $(moduleSourceNamed \"Example.Simple\") $ do\n        runViewContext Root () int\n where\n  getRunning = do\n    markdocs \"Hyperbole applications are divided into top-level `Page`s, which run side effects, then return an HTML `View`\"\n    snippet $ raw $ $(embedTopLevel \"Example.Docs.BasicPage\" \"hello\")\n\n    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\\\"\"\n\n    snippet $ do\n      raw $ $(embedTopLevel \"Example.Docs.BasicPage\" \"main\")\n\n    col ~ embed $ do\n      \"Hello World\"\n\n  htmlViews = do\n    markdocs \"`View`s are HTML fragments with a `context`\"\n    snippet $ raw $ $(embedTopLevel \"Example.Docs.BasicPage\" \"helloWorld\")\n\n    --  WARNING: this doesn't render properly when embedded in markdown\n    snippet $\n      text\n        [i|>>> renderText helloWorld\n\"<div>Hello World</div>\"|]\n\n    markdocs \"We can factor `View`s into reusable functions:\"\n    snippet $ do\n      rawMulti\n        [ $(embedTopLevel \"Example.Docs.BasicPage\" \"messageView\")\n        , $(embedTopLevel \"Example.Docs.BasicPage\" \"page\")\n        ]\n\n    col ~ embed $ do\n      \"Hello World\"\n\n    markdocs \"Using [atomic-css](/css) we can use functions to factor styles as well\"\n"
  },
  {
    "path": "demo/App/Page/Intro/Intro.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.Intro.Intro where\n\nimport App.Docs\nimport App.Route\nimport Data.String.Interpolate (i)\nimport Example.Colors\nimport Example.Counter (Counter)\nimport Example.Simple (Message)\nimport Example.Simple qualified as Simple\nimport Example.Style.Cyber qualified as Cyber\nimport Example.View.Layout (layout)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.HyperView.Types\nimport Web.Hyperbole.Page (subPage)\n\npage :: (Hyperbole :> es) => Page es '[Message, Counter]\npage = do\n  simple <- subPage Simple.page\n\n  pure $ layout Intro $ do\n    col ~ gap 20 $ do\n      row ~ color cyan . bg Dark . pad 20 $ do\n        space\n        col ~ gap 10 . overflow Hidden $ do\n          row $ do\n            space\n            codeblock ~ scaleText $ do\n              [i|╔═════════════════════════════════════════════════════════════════════════════╗\n║                                                                             ║\n║  ██╗  ██╗██╗   ██╗██████╗ ███████╗██████╗ ██████╗  ██████╗ ██╗     ███████╗ ║\n║  ██║  ██║╚██╗ ██╔╝██╔══██╗██╔════╝██╔══██╗██╔══██╗██╔═══██╗██║     ██╔════╝ ║\n║  ███████║ ╚████╔╝ ██████╔╝█████╗  ██████╔╝██████╔╝██║   ██║██║     █████╗   ║\n║  ██╔══██║  ╚██╔╝  ██╔═══╝ ██╔══╝  ██╔══██╗██╔══██╗██║   ██║██║     ██╔══╝   ║\n║  ██║  ██║   ██║   ██║     ███████╗██║  ██║██████╔╝╚██████╔╝███████╗███████╗ ║\n║  ╚═╝  ╚═╝   ╚═╝   ╚═╝     ╚══════╝╚═╝  ╚═╝╚═════╝  ╚═════╝ ╚══════╝╚══════╝ ║\n╚═════════════════════════════════════════════════════════════════════════════╝\n|]\n            space\n          el ~ fontSize 18 . Cyber.font . bold . textAlign AlignCenter $ do\n            el \"Create interactive HTML applications with type-safe serverside Haskell.\"\n            el \"Inspired by HTMX, Elm, and Phoenix LiveView\"\n        space\n\n      col ~ gap 10 $ do\n        example $(moduleSourceNamed \"Example.Simple\") $ do\n          runViewContext Root () simple\n\n        snippet $ do\n          raw $(embedTopLevel \"Example.Simple\" \"{-# LANGUAGE\")\n          raw \"\\nmodule Main where\\n\\n\"\n          raw $(embedSource \"Example.Simple\" (isTopLevel \"import\") (const True))\n\n        section' \"But Why?\" $ do\n          markdocs $(embedFile \"docs/intro.md\")\n\n        section' \"When not to use Hyperbole?\" $ do\n          markdocs $(embedFile \"docs/intro-downsides.md\")\n\n        section' \"Documentation\" $ do\n          markdocs $(embedFile \"docs/intro-links.md\")\n where\n  scaleText :: (Styleable h) => CSS h -> CSS h\n  scaleText =\n    utility\n      \"scale-text\"\n      [ \"font-size\" :. \"clamp(0.4rem, 1.5vw, 1rem)\"\n      , \"max-width\" :. \"100%\"\n      ]\n"
  },
  {
    "path": "demo/App/Page/OAuth2.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule App.Page.OAuth2 where\n\nimport App.Config (AppConfig (..))\nimport App.Docs\nimport App.Route qualified as Route\nimport Data.Aeson (eitherDecode)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, pack)\nimport Effectful\nimport Effectful.Reader.Dynamic\nimport Example.Style.Cyber as Cyber (btn, font)\nimport Example.View.Layout\nimport Network.HTTP.Client qualified as HTTP\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.URI (Endpoint (..), (./.))\nimport Web.Hyperbole.Effect.OAuth2 (Access, OAuth2, Token (..))\nimport Web.Hyperbole.Effect.OAuth2 qualified as OAuth2\nimport Web.Hyperbole.Types.Response (ResponseError (ErrAuth))\n\n--------------------------------------------------------------------------------\n-- App Specific Login\n--------------------------------------------------------------------------------\n\n-- This code belongs in an application-wide module\n-- This example uses a mock OAuth2 server: https://app.beeceptor.com/mock-server/oauth-mock\n\ndata UserSession = UserSession\n  { auth :: OAuth2.Authenticated\n  , email :: Text\n  }\n  deriving (Generic, ToEncoded, FromEncoded)\ninstance Session UserSession where\n  -- we want it to work on any page, not just this one\n  cookiePath = Just []\n\nopenLogin :: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es) => Eff es a\nopenLogin = do\n  Endpoint appRoot <- (.endpoint) <$> ask @AppConfig\n  let redirectUrl = appRoot ./. routePath (Route.Examples Route.OAuth2Authenticate)\n  u <- OAuth2.authUrl redirectUrl \"email\"\n  redirect u\n\nlogout :: (Hyperbole :> es) => Eff es ()\nlogout = deleteSession @UserSession\n\n-- | Target of the redirect after the user logs in via OAuth2\nhandleRedirect :: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es, IOE :> es) => Eff es Response\nhandleRedirect = do\n  authCode <- OAuth2.validateCode\n  auth <- OAuth2.exchangeAuth authCode\n  info <- fetchUserInfo auth.accessToken\n  saveSession @UserSession $ UserSession auth info.email\n  redirect $ routeUri (Route.Examples Route.OAuth2)\n\ndata GithubUserInfo = GithubUserInfo\n  { email :: Text\n  }\n  deriving (Generic, FromJSON, Show)\n\n-- | Example authenticated request using an oauth access token. in a real app, this should be in an external effect, not IOE\nfetchUserInfo :: (IOE :> es, Reader AppConfig :> es, Hyperbole :> es) => Token Access -> Eff es GithubUserInfo\nfetchUserInfo (Token accessTok) = do\n  app <- ask @AppConfig\n  req <- HTTP.parseRequest \"https://oauth-mock.mock.beeceptor.com/userinfo/github\"\n  res <- liftIO (HTTP.httpLbs (HTTP.applyBearerAuth (cs accessTok) req) app.manager)\n  case eitherDecode @GithubUserInfo (HTTP.responseBody res) of\n    Left e -> respondError $ ErrAuth $ \"Could not parse user info: \" <> pack (show e)\n    Right info -> do\n      liftIO $ putStrLn \"GOT\"\n      liftIO $ print info\n      pure info\n\n--------------------------------------------------------------------------------\n-- Page / Views\n--------------------------------------------------------------------------------\n\npage\n  :: (Hyperbole :> es, OAuth2 :> es, Reader AppConfig :> es)\n  => Page es '[Contents]\npage = do\n  muser <- lookupSession @UserSession\n  pure $ layout (Route.Examples Route.OAuth2) $ do\n    col ~ gap 10 $ do\n      el \"Hyperbole provides some helpers to make OAuth2 easier. This is done in 2 steps:\"\n      el \"1. Initiate the login via the OAuth provider given a redirect url\"\n      el \"2. After the redirect, the library validates the response and fetches an access token from the oauth provider.\"\n      el \"The developer can then make authenticated requests, and store a user session\"\n      example $(moduleSource) $ do\n        hyper Contents $ viewContents muser\n\ndata Contents = Contents\n  deriving (Generic, ViewId)\n\ninstance (OAuth2 :> es, Reader AppConfig :> es) => HyperView Contents es where\n  data Action Contents\n    = Logout\n    | Login\n    deriving (Generic, ViewAction)\n\n  update Login = do\n    openLogin\n  update Logout = do\n    logout\n    pure $ viewContents Nothing\n\nviewContents :: Maybe UserSession -> View Contents ()\nviewContents mt = do\n  col ~ gap 10 $ do\n    maybe viewUnauthorized viewAuthorized mt\n\nviewUnauthorized :: View Contents ()\nviewUnauthorized = do\n  message \"Logged Out!\"\n  col ~ gap 5 $ do\n    button Login \"Login\" ~ btn\n\nviewAuthorized :: UserSession -> View Contents ()\nviewAuthorized user = do\n  let auth = user.auth\n  message \"Successfully Logged In!\"\n  el ~ pad 5 . grid' . gap 10 $ do\n    dataItem \"Email\" user.email\n    dataItem \"Token Type\" $ pack $ show auth.tokenType\n    dataItem \"Access Token\" auth.accessToken.value\n    dataItem \"Expires In\" $ pack $ show auth.expiresIn\n    dataItem \"Refresh Token\" $ pack $ show auth.refreshToken\n    dataItem \"Scope\" $ pack $ show auth.scope\n  button Logout \"Logout\" ~ btn\n where\n  dataItem :: Text -> Text -> View c ()\n  dataItem lbl cnt = do\n    el ~ bold $ do\n      text lbl\n    el ~ overflow Hidden $ text cnt\n\n  grid' :: (Styleable h) => CSS h -> CSS h\n  grid' =\n    utility\n      \"grid\"\n      [ \"display\" :. \"grid\"\n      , \"grid-template-columns\" :. \"max-content auto\"\n      , \"align-items\" :. \"center\"\n      ]\n\nmessage :: View c () -> View c ()\nmessage x = el x ~ pad 10 . Cyber.font . border 1\n"
  },
  {
    "path": "demo/App/Page/SideEffects.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.SideEffects where\n\nimport App.Docs\nimport App.Route as Route (AppRoute (SideEffects))\nimport Example.Counter (Counter (..))\nimport Example.Docs.SideEffects as SideEffects\nimport Example.View.Layout (layoutSubnav)\nimport Web.Hyperbole\n\ndata EffectsSection\n  = Effectful\n  | Other\n  | Custom\n  deriving (Show, Enum, Bounded)\n\ninstance PageAnchor EffectsSection where\n  sectionTitle Other = \"Reader and More\"\n  sectionTitle Custom = \"Databases and Custom Effects\"\n  sectionTitle a = camelTitle a\n\npage :: (Hyperbole :> es) => Page es '[Counter, SlowReader, Titler]\npage = do\n  pure $ layoutSubnav @EffectsSection Route.SideEffects $ do\n    section Effectful $ do\n      markdocs $(embedFile \"docs/effectful.md\")\n      example SideEffects.source $ do\n        hyper Titler titleView\n\n    section Other $ do\n      markdocs $(embedFile \"docs/effects-other.md\")\n      example SideEffects.source $ do\n        hyper SlowReader $ messageView \"...\"\n\n    section Custom $ do\n      markdocs $(embedFile \"docs/effects-custom.md\")\n"
  },
  {
    "path": "demo/App/Page/State.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.State where\n\nimport App.Docs\nimport App.Route (AppRoute (State))\nimport Effectful.Concurrent\nimport Effectful.Concurrent.STM (TVar)\nimport Effectful.Reader.Dynamic\nimport Example.Counter as Threaded\nimport Example.State.Effects as Effects\nimport Example.State.Query (QueryPrefs (..))\nimport Example.State.Query qualified as Query\nimport Example.State.Sessions qualified as Session\nimport Example.State.Stateless\nimport Example.State.ViewState qualified as ViewState\nimport Example.View.Layout (layoutSubnav)\nimport Web.Hyperbole\n\ndata StateSection\n  = Stateless\n  | ActionThreading\n  | ViewState\n  | BrowserQuery\n  | BrowserSessions\n  | WithEffects\n  deriving (Show, Enum, Bounded)\n\ninstance PageAnchor StateSection\n\npage :: (Hyperbole :> es, Reader (TVar Int) :> es, Concurrent :> es) => Page es '[Threaded.Counter, Swapper, QueryPrefs, Session.Contents, Effects.Counter, ViewState.Counter]\npage = do\n  ssn <- session @Session.Preferences\n  qry <- query @Query.Preferences\n  cnt <- getCount\n  pure $ layoutSubnav @StateSection State $ do\n    section Stateless $ do\n      markdocs $(embedFile \"docs/state-stateless.md\")\n\n      example $(moduleSourceNamed \"Example.State.Stateless\") $ do\n        hyper Swapper viewSwap\n\n    section ActionThreading $ do\n      markdocs $(embedFile \"docs/state-threading.md\")\n\n      example $(moduleSourceNamed \"Example.Counter\") $ do\n        hyper Threaded.Counter $ Threaded.viewCount 0\n\n    section ViewState $ do\n      markdocs $(embedFile \"docs/state-viewstate.md\")\n\n      example $(moduleSourceNamed \"Example.State.ViewState\") $ do\n        hyperState ViewState.CounterState 0 ViewState.viewCount\n\n    section BrowserQuery $ do\n      markdocs $(embedFile \"docs/state-browser.md\")\n\n      example $(moduleSourceNamed \"Example.State.Query\") $ do\n        hyper QueryPrefs $ Query.viewPreferences qry\n\n    section BrowserSessions $ do\n      markdocs $(embedFile \"docs/state-sessions.md\")\n\n      example $(moduleSourceNamed \"Example.State.Sessions\") $ do\n        hyper Session.Contents $ Session.viewContent ssn\n\n    section WithEffects $ do\n      markdocs $(embedFile \"docs/state-effects.md\")\n\n      example $(moduleSourceNamed \"Example.State.Effects\") $ do\n        hyper Effects.Counter $ Effects.viewCount cnt\n"
  },
  {
    "path": "demo/App/Page/ViewFunctions.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule App.Page.ViewFunctions where\n\nimport App.Docs\nimport App.Route qualified as Route\nimport Example.Docs.ViewFunctions as VF\nimport Example.Push qualified as Push\nimport Example.View.Layout (layoutSubnav)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Basics\n  = ViewFunctions\n  | NotComponents\n  deriving (Show, Enum, Bounded)\ninstance PageAnchor Basics\n\npage :: (Hyperbole :> es) => Page es '[Message, Toggler, Progress, Push.Tasks]\npage = do\n  pure $ layoutSubnav @Basics Route.ViewFunctions $ do\n    section ViewFunctions $ do\n      markdocs $(embedFile \"docs/view-functions.md\")\n\n      example VF.source $ do\n        hyper VFMessage $ messageView \"Hello\"\n\n    section NotComponents $ do\n      markdocs $(embedFile \"docs/view-components.md\")\n\n      example VF.source $ do\n        hyper Toggler $ toggler False\n\n      col ~ pad (T 20) . gap 10 $ do\n        markdocs $(embedFile \"docs/view-functions-wrap.md\")\n\n      example VF.source $ do\n        -- hyper Push.Tasks $ Push.taskView 0\n        hyper Progress $ workingHard 0.1\n\n      col ~ pad (T 20) . gap 10 $ do\n        markdocs $(embedFile \"docs/view-functions-end.md\")\n"
  },
  {
    "path": "demo/App/Route.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule App.Route where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, unpack)\nimport Text.Casing (fromHumps, toWords)\nimport Text.Read (readMaybe)\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.Route\n\ntype UserId = Int\n\ndata AppRoute\n  = Main\n  | Intro\n  | Basics\n  | CSS\n  | Simple\n  | Hello Hello\n  | Contacts ContactRoute\n  | Interactivity\n  | SideEffects\n  | Hyperviews\n  | State\n  | Counter\n  | Forms FormRoute\n  | HyperboleEffect\n  | Response\n  | Concurrency\n  | Data DataRoute\n  | Examples ExamplesRoute\n  | Errors\n  | Javascript\n  | Test TestRoute\n  | ViewFunctions\n  | Application\n  deriving (Eq, Generic, Show)\ninstance Route AppRoute where\n  baseRoute = Just Main\n\n-- -- View Route\n-- data IntroRoute\n--   = IntroMain\n--   | Pages\n--   | Views\n--   | HyperViews\n--   | ViewFunctions\n--   | CSS CSSRoute\n--   deriving (Eq, Generic, Show)\n-- instance Route IntroRoute where\n--   baseRoute = Just IntroMain\n\ndata FormRoute\n  = FormSimple\n  | FormValidation\n  deriving (Eq, Generic, Show)\ninstance Route FormRoute where\n  baseRoute = Just FormSimple\n\ndata DataRoute\n  = DataLists\n  | SortableTable\n  | Autocomplete\n  | Filter\n  | LoadMore\n  deriving (Eq, Generic, Show)\ninstance Route DataRoute where\n  baseRoute = Just DataLists\n\n-- data StateRoute\n--   = StateRoot\n--   | Actions\n--   | StateView\n--   | Effects\n--   | Query\n--   | Sessions\n--   deriving (Eq, Generic, Show)\n-- instance Route StateRoute where\n--   baseRoute = Just StateRoot\n\ndata ContactRoute\n  = ContactsAll\n  | Contact UserId\n  deriving (Eq, Generic, Show)\ninstance Route ContactRoute where\n  baseRoute = Just ContactsAll\n\n  matchRoute [contactId] = do\n    cid <- readMaybe $ unpack contactId\n    pure $ Contact cid\n  matchRoute [] = pure ContactsAll\n  matchRoute other = genMatchRoute other.segments\n\n  routePath (Contact uid) = routePath uid\n  routePath ContactsAll = []\n\ndata ExamplesRoute\n  = OtherExamples\n  | Todos\n  | TodosCSS -- A version using the CSS from TodoMVC project\n  | Tags\n  | OAuth2Authenticate\n  | OAuth2\n  | Chat\n  | Scrollbars\n  deriving (Eq, Generic, Show)\ninstance Route ExamplesRoute where\n  baseRoute = Just OtherExamples\n\ndata TestRoute\n  = TestMain\n  | TestState\n  deriving (Eq, Generic, Show)\ninstance Route TestRoute where\n  baseRoute = Just TestMain\n\ndata Hello\n  = Greet Text\n  | Redirected\n  | RedirectNow\n  deriving (Eq, Generic, Route, Show)\n\nrouteTitle :: AppRoute -> Text\nrouteTitle (Hello _) = \"Hello World\"\nrouteTitle CSS = \"Styles\"\n-- routeTitle (Intro IntroMain) = \"Intro\"\n-- routeTitle (Intro (CSS _)) = \"Atomic CSS\"\n-- routeTitle (Intro r) = defaultTitle r\nrouteTitle (Contacts ContactsAll) = \"Contacts\"\nrouteTitle State = \"Managing State\"\nrouteTitle Hyperviews = \"More HyperViews\"\n-- routeTitle (State StateRoot) = \"State\"\n-- routeTitle (State StateView) = \"Built-in State\"\n-- routeTitle (State Actions) = \"Managing State\"\n-- routeTitle (State Query) = \"Query\"\n-- routeTitle (State Sessions) = \"Sessions\"\nrouteTitle (Forms FormSimple) = \"Forms\"\nrouteTitle (Forms FormValidation) = \"Form Validation\"\nrouteTitle (Data d) = defaultTitle d\nrouteTitle Errors = \"Error Handling\"\nrouteTitle (Examples Todos) = \"TodoMVC\"\nrouteTitle (Examples TodosCSS) = \"TodoMVC (CSS version)\"\nrouteTitle (Examples OAuth2) = \"OAuth2\"\nrouteTitle (Examples OtherExamples) = \"Examples\"\nrouteTitle (Examples e) = defaultTitle e\nrouteTitle r = defaultTitle r\n\ndefaultTitle :: (Show r) => r -> Text\ndefaultTitle = cs . toWords . fromHumps . show\n"
  },
  {
    "path": "demo/App/Style.hs",
    "content": "module App.Style where\n\nimport Example.Colors\nimport Web.Atomic.CSS\n\n-- btn :: (Styleable h) => CSS h -> CSS h\n-- btn = btn' Primary\n--\n-- btn' :: (Styleable h) => AppColor -> CSS h -> CSS h\n-- btn' clr =\n--   bg clr\n--     . hover (bg (hovClr clr))\n--     . color (txtClr clr)\n--     . pad 10\n--     . shadow ()\n--     . rounded 3\n--  where\n--   hovClr Primary = PrimaryLight\n--   hovClr c = c\n--   txtClr _ = White\n\nbtnLight :: (Styleable h) => CSS h -> CSS h\nbtnLight =\n  base\n    . border 2\n    . borderColor Secondary\n    . color Secondary\n    . hover (borderColor SecondaryLight . color SecondaryLight)\n where\n  base = pad (XY 15 8)\n\nh1 :: (Styleable h) => CSS h -> CSS h\nh1 = bold . fontSize 32\n\ninvalid :: (Styleable h) => CSS h -> CSS h\ninvalid = color Danger\n\nsuccess :: (Styleable h) => CSS h -> CSS h\nsuccess = color Success\n\nlink :: (Styleable h) => CSS h -> CSS h\nlink = color Primary . underline\n\ninput :: (Styleable h) => CSS h -> CSS h\ninput = border 1 . pad 8\n\nstrikethrough :: (Styleable h) => CSS h -> CSS h\nstrikethrough =\n  utility \"strike\" [\"text-decoration\" :. \"line-through\"]\n\nuppercase :: (Styleable h) => CSS h -> CSS h\nuppercase = utility \"upper\" [\"text-transform\" :. \"uppercase\"]\n"
  },
  {
    "path": "demo/App.hs",
    "content": "{-# LANGUAGE OverloadedStrings #-}\n{-# OPTIONS_GHC -Wno-unused-imports #-}\n\nmodule App where\n\nimport App.Cache (clientCache)\nimport App.Config\nimport App.Docs.Page\nimport App.Page.Application qualified as Application\nimport App.Page.CSS qualified as CSS\nimport App.Page.Concurrency qualified as Concurrency\nimport App.Page.Examples qualified as Examples\nimport App.Page.Forms qualified as Forms\nimport App.Page.HyperboleEffect qualified as Hyp\nimport App.Page.Hyperviews qualified as Hyperviews\nimport App.Page.Interactivity qualified as Interactivity\nimport App.Page.Intro.Basics qualified as Basics\nimport App.Page.Intro.Intro qualified as Intro\nimport App.Page.OAuth2 qualified as OAuth2\nimport App.Page.SideEffects qualified as SideEffects\nimport App.Page.State qualified as State\nimport App.Page.ViewFunctions qualified as ViewFunctions\nimport App.Route as Route\nimport Control.Concurrent\n  ( MVar\n  , ThreadId\n  , forkFinally\n  , killThread\n  , newEmptyMVar\n  , putMVar\n  , takeMVar\n  )\nimport Control.Monad (forever, when, (>=>))\nimport Data.ByteString.Lazy qualified as BL\nimport Data.IORef (IORef, newIORef, readIORef, writeIORef)\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Data.String.Interpolate (i)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Data.Text.Lazy qualified as L\nimport Data.Text.Lazy.Encoding qualified as L\nimport Data.Version (showVersion)\nimport Effectful\nimport Effectful.Concurrent.STM\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Environment (runEnvironment)\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Static.Local\nimport Example.Chat qualified as Chat\nimport Example.Colors\nimport Example.Contact qualified as Contact\nimport Example.Contacts qualified as Contacts\nimport Example.Counter qualified as Counter\nimport Example.DataLists.Autocomplete qualified as Autocomplete\nimport Example.DataLists.DataTable qualified as DataTable\nimport Example.DataLists.Filter qualified as Filter\nimport Example.DataLists.LoadMore qualified as LoadMore\nimport Example.Effects.Debug as Debug\nimport Example.Effects.Todos (Todos, runTodosSession)\nimport Example.Effects.Users as Users\nimport Example.Scrollbars qualified as Scrollbars\nimport Example.State.Effects qualified as Effects\nimport Example.State.Query qualified as Query\nimport Example.State.Sessions qualified as Sessions\nimport Example.State.ViewState qualified as ViewState\nimport Example.Style qualified as Style\nimport Example.Style.Cyber qualified as Cyber\nimport Example.Tags qualified as Tags\nimport Example.Test qualified as Test\nimport Example.Todos.Todo qualified as Todo\nimport Example.Todos.TodoCSS qualified as TodoCSS\nimport Example.View.Layout as Layout (layout)\nimport Foreign.Store (Store (..), lookupStore, readStore, storeAction, withStore)\nimport GHC.Generics (Generic)\nimport GHC.Word (Word32)\nimport Network.HTTP.Client qualified as HTTP\nimport Network.HTTP.Client.TLS qualified as HTTPS\nimport Network.HTTP.Types (Header, Method, QueryItem, hCacheControl, methodPost, status200, status404)\nimport Network.Wai qualified as Wai\nimport Network.Wai.Handler.Warp qualified as Warp\nimport Network.Wai.Middleware.Static as Static (CacheContainer, CachingStrategy (..), Options (..), addBase)\nimport Network.Wai.Middleware.Static qualified as Static\nimport Network.WebSockets (Connection, PendingConnection, acceptRequest, defaultConnectionOptions)\nimport Paths_demo (version)\nimport Paths_demo qualified as Pt\nimport Safe (readMay)\nimport System.Environment qualified as SE\nimport System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Application\nimport Web.Hyperbole.Effect.GenRandom\nimport Web.Hyperbole.Effect.OAuth2 (OAuth2, runOAuth2)\nimport Web.Hyperbole.Effect.OAuth2 qualified as OAuth2\nimport Web.Hyperbole.Server.Options (defaultError)\nimport Web.Hyperbole.Types.Response\n\nrun :: IO ()\nrun = do\n  hSetBuffering stdout LineBuffering\n\n  port <- do\n    mStr <- SE.lookupEnv \"PORT\"\n    pure $ fromMaybe 3000 (readMay =<< mStr)\n  putStrLn $ \"Starting Examples on http://localhost:\" <> show port\n\n  users <- Users.initUsers\n  (count, room, config) <- runEff $ runEnvironment $ do\n    c <- runConcurrent Effects.initCounter\n    room <- runConcurrent Chat.initChatRoom\n    a <- getAppConfigEnv\n    pure (c, room, a)\n\n  cache <- clientCache\n\n  Warp.run port $\n    Static.staticPolicyWithOptions cache (addBase \"client/dist\") $\n      Static.staticPolicy (addBase \"demo/static\") $ do\n        devReload config $ exampleApp config users count room\n where\n  devReload :: AppConfig -> Application -> Application\n  devReload config\n    | config.devMode = Wai.modifyResponse $ Wai.mapResponseHeaders $ \\hs -> (\"Connection\", \"Close\") : hs\n    | otherwise = id\n\nexampleApp :: AppConfig -> UserStore -> TVar Int -> Chat.Room -> Application\nexampleApp config users count chats = do\n  liveAppWith\n    (ServerOptions (document documentHead) serverError)\n    (runApp . routeRequest $ router)\n where\n  runApp :: (Hyperbole :> es, IOE :> es) => Eff (OAuth2 : GenRandom : Concurrent : Debug : Users : Todos : Reader AppConfig : es) a -> Eff es a\n  runApp = runReader config . runTodosSession . runUsersIO users . runDebugIO . runConcurrent . runRandom . runOAuth2 config.oauth config.manager\n\n  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\n  router Counter = runPage Counter.page\n  router (Hello h) = runPage $ hello h\n  router (Contacts (Contact uid)) = Contact.response uid\n  router (Contacts ContactsAll) = runPage Contacts.page\n  router Concurrency = runPage Concurrency.page\n  router (Data r) =\n    case r of\n      DataLists -> redirect $ routeUri (Data SortableTable)\n      SortableTable -> runPage DataTable.page\n      Autocomplete -> runPage Autocomplete.page\n      Filter -> runPage Filter.page\n      LoadMore -> runPage LoadMore.page\n  router Errors = redirect (routeUri HyperboleEffect)\n  router (Forms _) = runPage Forms.page\n  router HyperboleEffect = runPage Hyp.page\n  router Hyperviews = runPage Hyperviews.page\n  router Route.Response = redirect (routeUri HyperboleEffect)\n  router State = runReader count $ runPage State.page\n  router SideEffects = runReader @Text \"Secret Message!\" $ runPage SideEffects.page\n  router Intro = runPage Intro.page\n  router Basics = runPage Basics.page\n  router Application = runPage Application.page\n  router ViewFunctions = runPage ViewFunctions.page\n  -- router (Intro HyperViews) = runPage IntroHyperViews.page\n  -- router (Intro Pages) = runPage IntroPages.page\n  -- router (Intro ViewFunctions) = runPage IntroViewFunctions.page\n  router CSS = runPage CSS.page\n  router Interactivity = runPage Interactivity.page\n  router (Examples Chat) = runReader chats $ runPage Chat.page\n  router (Examples OtherExamples) = runPage Examples.page\n  router (Examples Todos) = runPage Todo.page\n  router (Examples Tags) = runPage Tags.page\n  router (Examples TodosCSS) = runPage TodoCSS.page\n  router Javascript = redirect (routeUri Interactivity)\n  router (Examples OAuth2) = runPage OAuth2.page\n  router (Examples OAuth2Authenticate) = OAuth2.handleRedirect\n  router (Examples Scrollbars) = runPage Scrollbars.page\n  router Simple = redirect (routeUri Intro)\n  -- router Counter = redirect (routeUri $ State StateRoot)\n  router (Test TestMain) = runPage Test.page\n  router (Test TestState) = runPage ViewState.page\n  router Main = do\n    redirect (routeUri Intro)\n\n  -- Nested Router\n  hello :: (Hyperbole :> es, Debug :> es) => Hello -> Page es '[]\n  hello RedirectNow = do\n    redirect (routeUri $ Hello Redirected)\n  hello (Greet who) = do\n    pure $ layout (Hello $ Greet who) $ do\n      row ~ gap 6 . pad 10 $ do\n        el \"Hello:\"\n        el $ text who\n  hello Redirected = do\n    pure $ layout HyperboleEffect $ do\n      col ~ pad 10 . gap 10 $ do\n        el \"You were redirected\"\n        route HyperboleEffect ~ Style.link $ \"Go Back\"\n\n  -- Use the embedded version for real applications (see quickStartDocument).\n  -- The link to /hyperbole.js here is just to make local development easier\n  documentHead :: View DocumentHead ()\n  documentHead = do\n    title \"Hyperbole Examples\"\n    mobileFriendly\n    stylesheet \"/cyber.css\"\n    script \"/hyperbole.js\"\n    stylesheet \"/prism.css\"\n    script \"/prism.js\" @ att \"defer\" \"\"\n    script \"/docs.js\" @ att \"defer\" \"\"\n    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'}\"\n    style cssEmbed\n\n    when config.devMode $ do\n      script' scriptLiveReload\n\n  serverError :: ResponseError -> ServerError\n  -- serverError NotFound = ServerError \"NotFound\" $ Cyber.cyberError \"Custom Not Found!\"\n  serverError (ErrCustom s) = s\n  serverError err =\n    let msg = defaultErrorMessage err\n     in ServerError\n          { message = msg\n          , body = Cyber.cyberError $ Cyber.glitch msg\n          }\n\n{- | Made for local development\n -\n - ghcid --setup=Main.update --command=\"cabal repl exe:examples lib:hyperbole test\" --run=Main.update --warnings\n -\n - Start or restart the server.\nnewStore is from foreign-store.\nA Store holds onto some data across ghci reloads\n-}\nupdate :: IO ()\nupdate = do\n  mtidStore <- lookupStore tidStoreNum\n  case mtidStore of\n    -- no server running\n    Nothing -> do\n      done <- storeAction doneStore newEmptyMVar\n      tid <- start done\n      _ <- storeAction (Store tidStoreNum) (newIORef tid)\n      return ()\n    -- server is already running\n    Just tidStore -> do\n      restartAppInNewThread tidStore\n where\n  -- callCommand \"xmonadctl refreshFirefox\"\n\n  doneStore :: Store (MVar ())\n  doneStore = Store 0\n\n  -- shut the server down with killThread and wait for the done signal\n  restartAppInNewThread :: Store (IORef ThreadId) -> IO ()\n  restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \\tid -> do\n    killThread tid\n    withStore doneStore takeMVar\n    readStore doneStore >>= start\n\n  -- \\| Start the server in a separate thread.\n  start\n    :: MVar ()\n    -- \\^ Written to when the thread is killed.\n    -> IO ThreadId\n  start done = do\n    forkFinally\n      App.run\n      -- Note that this implies concurrency\n      -- between shutdownApp and the next app that is starting.\n      -- Normally this should be fine\n      (\\_ -> putMVar done ())\n\ntidStoreNum :: Word32\ntidStoreNum = 1\n\nmodifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()\nmodifyStoredIORef store f = withStore store $ \\ref -> do\n  v <- readIORef ref\n  f v >>= writeIORef ref\n\ncacheMiddleware :: Application -> Application\ncacheMiddleware = Wai.modifyResponse addCache\n where\n  addCache = Wai.mapResponseHeaders ((hCacheControl, \"private, max-age=60\") :)\n"
  },
  {
    "path": "demo/Example/CSS/External.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.External where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Web.Hyperbole\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\nmain :: IO ()\nmain = do\n  run 3000 $ do\n    liveApp quickStartDocument (runPage page)\n\npage :: (Hyperbole :> es) => Page es '[Items]\npage = do\n  pure $ do\n    -- you can choose to include a stylesheet only on pages\n    -- that use it or load it globally in your document function\n    stylesheet \"external.css\"\n    hyper Items $ itemsView \"one\"\n\ndata Items = Items\n  deriving (Generic, ViewId)\n\ninstance HyperView Items es where\n  data Action Items = Select Text\n    deriving (Generic, ViewAction)\n\n  update (Select t) = do\n    pure $ itemsView t\n\nitemsView :: Text -> View Items ()\nitemsView sel = do\n  el @ class_ \"parent\" $ do\n    item \"one\"\n    item \"two\"\n    item \"three\"\n    item \"four\"\n    item \"five\"\n where\n  selected i =\n    if sel == i\n      then class_ \"selected\"\n      else id\n\n  item i =\n    -- the class_ attribute MERGES classes if you set it more than once\n    button (Select i) @ class_ \"item\" . selected i $ text i\n"
  },
  {
    "path": "demo/Example/CSS/Loading.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.CSS.Loading where\n\nimport Data.Text (Text)\nimport Example.Effects.Debug\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Loader = Loader\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es) => HyperView Loader es where\n  data Action Loader\n    = LoadSlow\n    deriving (Generic, ViewAction)\n\n  update LoadSlow = do\n    delay 1000\n    pure $ viewLoaders \"OK!\"\n\nviewLoaders :: Text -> View Loader ()\nviewLoaders status = do\n  col ~ gap 10 $ do\n    row ~ gap 10 . whenLoading flexRow . display None $ do\n      loadingBars\n      el \"Loading...\"\n    el ~ whenLoading (display None) $ text status\n    button LoadSlow ~ btn . whenLoading (opacity 0.5) $ \"Load Slow\"\n\nloadingBars :: View c ()\nloadingBars = el ~ cls \"loader\" $ none\n"
  },
  {
    "path": "demo/Example/CSS/Tooltips.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.Tooltips where\n\nimport App.Docs\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\ntooltips :: View c ()\ntooltips = do\n  col ~ pad 10 . gap 10 . width 300 $ do\n    mapM_ viewItemRow [\"One\", \"Two\", \"Three\", \"Four\", \"Five\", \"Six\"]\n where\n  viewItemRow item = do\n    col ~ stack . showTooltips . hover (color Primary) . pointer $ do\n      el ~ border 1 . bg White . pad 5 $ text item\n      el ~ cls \"tooltip\" . popup (TR 10 10) . zIndex 1 . visibility Hidden $ do\n        col ~ border 2 . gap 5 . bg White . pad 5 $ do\n          el ~ bold $ \"DETAILS\"\n          el $ text item\n          el \"details about this item\"\n\n  showTooltips =\n    css\n      \"tooltips\"\n      \".tooltips:hover > .tooltip\"\n      (declarations (visibility Visible))\n"
  },
  {
    "path": "demo/Example/CSS/Transitions.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.CSS.Transitions where\n\nimport App.Docs\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\ndata Animate = Animate\n  deriving (Generic, ViewId)\n\ninstance HyperView Animate es where\n  data Action Animate\n    = Expand\n    | Collapse\n    deriving (Generic, ViewAction)\n  update Expand = do\n    pure viewBig\n  update Collapse = do\n    pure viewSmall\n\nviewSmall :: View Animate ()\nviewSmall = do\n  col ~ gap 10 . transition 300 (Width 200) $ do\n    el \"Small\"\n    button Expand \"Expand\" ~ btn\n\nviewBig :: View Animate ()\nviewBig =\n  col ~ gap 10 . transition 300 (Width 400) $ do\n    el \"Expanded\"\n    button Collapse \"Collapse\" ~ btn\n"
  },
  {
    "path": "demo/Example/Chat.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Chat where\n\nimport App.Route\nimport Control.Monad (forM_, forever)\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Concurrent\nimport Effectful.Concurrent.STM\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Dynamic (modify)\nimport Example.Colors\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (embed)\nimport Example.Style.Cyber as Cyber (btn, font)\nimport Example.View.Layout (layout)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.Encoded (Encoded (..), FromEncoded (..), ToEncoded (..))\n\npage :: (Hyperbole :> es, Concurrent :> es, Reader Room :> es) => Page es '[Content, Chats, NewMessage]\npage = do\n  pure $ layout (Examples Chat) $ do\n    el \"Demonstrates server pushes and concurrency. Open in two tabs with different usernames to test.\"\n    col ~ embed . Cyber.font $ do\n      hyper Content $ contentView Nothing\n\ntype Username = Text\n\ndata Content = Content\n  deriving (Generic, ViewId)\n\ninstance HyperView Content es where\n  data Action Content = Login | Logout\n    deriving (Generic, ViewAction)\n\n  type Require Content = '[Chats, NewMessage]\n\n  update Login = do\n    LoginForm u <- formData\n    pure $ contentView (Just u)\n  update Logout =\n    pure $ contentView Nothing\n\ndata LoginForm = LoginForm\n  { username :: Text\n  }\n  deriving (Generic, FromForm)\n\ncontentView :: Maybe Username -> View Content ()\ncontentView mu = do\n  case mu of\n    Nothing -> do\n      form Login ~ flexRow . gap 10 $ do\n        field \"username\" $ do\n          input Username @ placeholder \"Username\" . autofocus ~ Style.input\n        submit \"Login\" ~ btn\n    Just u -> do\n      col ~ gap 10 $ do\n        row ~ gap 10 $ do\n          el \"Welcome \"\n          el ~ bold $ text u\n          space\n          button Logout ~ btn $ \"logout\"\n        hyperState Chats mempty $ chatsLoad u\n        hyper (NewMessage u) messageView\n\n-- Chat Room -------------------------------------\n\ndata Message = Message\n  { sender :: Username\n  , body :: Text\n  }\n  deriving (Generic, ToParam, FromParam)\n\nnewtype Room = Room (TChan Message)\nnewtype Subscription = Subscription (TChan Message)\n\ninitChatRoom :: (Concurrent :> es) => Eff es Room\ninitChatRoom = Room <$> newBroadcastTChanIO\n\nsubscribeChatRoom :: (Concurrent :> es) => Room -> Eff es Subscription\nsubscribeChatRoom (Room chan) = fmap Subscription <$> atomically $ dupTChan chan\n\nwaitMessage :: (Concurrent :> es) => Subscription -> Eff es Message\nwaitMessage (Subscription chan) = atomically $ readTChan chan\n\nsendMessage :: (Concurrent :> es) => Room -> Message -> Eff es ()\nsendMessage (Room chan) msg = atomically $ writeTChan chan msg\n\n-- Encoding for message history since starting\nnewtype AllMessages = AllMessages [Message]\n  deriving newtype (Semigroup, Monoid)\n\ninstance ToEncoded AllMessages where\n  toEncoded (AllMessages ms) = Encoded \"\" (fmap toParam ms)\ninstance FromEncoded AllMessages where\n  parseEncoded (Encoded _ ps) =\n    AllMessages <$> mapM parseParam ps\n\n--- Chat Updates ---------------------------------------------\n\ndata Chats = Chats\n  deriving (Generic)\ninstance ViewId Chats where\n  type ViewState Chats = AllMessages\n\ninstance (Concurrent :> es, Reader Room :> es, IOE :> es) => HyperView Chats es where\n  data Action Chats = Stream Username\n    deriving (Generic, ViewAction)\n\n  update (Stream u) = do\n    room <- ask\n    sub <- subscribeChatRoom room\n\n    sendMessage room $ Message u \"I have arrived!\"\n\n    forever (streamChats sub)\n   where\n    streamChats room = do\n      -- Block until we receive a message from the duplicated channel\n      msg <- waitMessage room\n\n      -- store all the messages we've seen in our view state\n      modify $ addMessage msg\n\n      -- update the view\n      pushUpdate $ chatsView u\n\naddMessage :: Message -> AllMessages -> AllMessages\naddMessage msg (AllMessages ms) = AllMessages $ msg : ms\n\nallMessages :: View Chats AllMessages\nallMessages = do\n  AllMessages ms <- viewState\n  pure $ AllMessages $ reverse ms\n\nchatsLoad :: Username -> View Chats ()\nchatsLoad user = el @ onLoad (Stream user) 100 $ \"...\"\n\nchatsView :: Username -> View Chats ()\nchatsView _user = do\n  AllMessages chats <- allMessages\n  col ~ gap 5 . pad 5 . minHeight 400 . border 1 . bg GrayLight $ do\n    forM_ chats $ \\chat -> do\n      el $ do\n        text chat.sender\n        text \": \"\n        text chat.body\n\n--- New Message Form ------------------------------\n\ndata NewMessage = NewMessage Username\n  deriving (Generic, ViewId)\n\ninstance (Concurrent :> es, Reader Room :> es, IOE :> es) => HyperView NewMessage es where\n  data Action NewMessage = SendMessage\n    deriving (Generic, ViewAction)\n\n  update SendMessage = do\n    room <- ask\n    NewMessage user <- viewId\n    MessageForm msg <- formData\n    sendMessage room $ Message user msg\n    -- NOTE: this doesn't show an update at all, but we are subscribed to the channel and will get a push like everyone else\n    pure messageView\n\ndata MessageForm = MessageForm\n  { message :: Text\n  }\n  deriving (Generic, FromForm)\n\nmessageView :: View NewMessage ()\nmessageView = do\n  form SendMessage ~ flexRow . gap 10 $ do\n    field \"message\" $ do\n      input TextInput @ placeholder \"type your message here\" . value \"\" . autofocus ~ Style.input . grow\n    submit \"Send\" ~ btn\n"
  },
  {
    "path": "demo/Example/Colors.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Colors where\n\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata AppColor\n  = White\n  | Light\n  | GrayLight\n  | GrayDark\n  | Dark\n  | DarkHighlight\n  | Success\n  | Danger\n  | Warning\n  | Primary\n  | PrimaryLight\n  | Secondary\n  | SecondaryLight\n  deriving (Show, Read, Eq, Generic, ToJSON, FromJSON, ToParam, FromParam)\n\ninstance Default AppColor where\n  def = White\n\ninstance ToColor AppColor where\n  colorValue White = \"#FFF\"\n  colorValue Light = \"#F2F2F3\"\n  colorValue GrayLight = \"#E3E5E9\"\n  colorValue GrayDark = \"#2С3С44\"\n  -- colorValue Dark = \"#2E3842\" -- \"#232C41\"\n  colorValue Dark = \"#121726\" -- \"#232C41\"\n  colorValue DarkHighlight = \"#343945\" -- \"#232C41\"\n  colorValue Primary = \"#4171b7\"\n  colorValue PrimaryLight = \"#6D9BD3\"\n  -- colorValue PrimaryLight = \"#e2ebf6\"\n  colorValue Secondary = \"#5D5A5C\"\n  colorValue SecondaryLight = \"#9D999C\"\n  -- colorValue Success = \"67C837\"\n  colorValue Success = \"#149e5a\"\n  colorValue Danger = midRed\n  colorValue Warning = \"#e1c915\"\n\nlightRed :: HexColor\nlightRed = HexColor \"#EC6458\"\n\nmidRed :: HexColor\nmidRed = HexColor \"#A03F38\"\n\ndarkRed :: HexColor\ndarkRed = HexColor \"#722C2A\"\n\ncyan :: HexColor\ncyan = \"#0FF\"\n\nmagenta :: HexColor\nmagenta = \"#E44072\"\n\nlight :: AppColor -> HexColor\nlight PrimaryLight = \"#a8c3e5\"\nlight Primary = colorValue PrimaryLight\n-- light Danger = \"#ef8379\"\nlight Danger = lightRed\nlight c = colorValue c\n\nhoverColor :: AppColor -> HexColor\nhoverColor = \\case\n  White -> colorValue Light\n  c -> light c\n\ncontrastColor :: AppColor -> HexColor\ncontrastColor = \\case\n  Primary -> colorValue White\n  PrimaryLight -> colorValue White\n  Danger -> colorValue White\n  _ -> colorValue Dark\n"
  },
  {
    "path": "demo/Example/Concurrency/LazyLoading.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.LazyLoading where\n\nimport App.Docs\nimport Effectful\nimport Example.Colors\nimport Example.Concurrency.Tasks\nimport Example.Effects.Debug\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Effect.GenRandom\n\n-----------------------------------------------------------\n-- Lazy Loading Expensive Data\n-----------------------------------------------------------\n\ndata LazyData = LazyData TaskId\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es, GenRandom :> es) => HyperView LazyData es where\n  data Action LazyData\n    = Details\n    deriving (Generic, ViewAction)\n\n  update Details = do\n    LazyData taskId <- viewId\n    task <- pretendLoadTask taskId\n    pure $ viewTaskDetails task\n\nviewTaskLoad :: View LazyData ()\nviewTaskLoad = do\n  -- 100ms after rendering, get the details\n  el @ onLoad Details 100 ~ bg GrayLight . textAlign AlignCenter $ do\n    text \"...\"\n\nviewTaskDetails :: Task -> View LazyData ()\nviewTaskDetails task = do\n  el ~ color Success . textAlign AlignCenter $ do\n    text task.details\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Concurrency/Overlap.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Overlap where\n\nimport App.Docs\nimport Data.Text (Text, pack)\nimport Effectful\nimport Example.Effects.Debug\nimport Example.Style.Cyber (btn)\nimport Example.View.Loader as Loader\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\n-- Concurrency = Drop  ---------------------------\n\ndata OverlapDrop = OverlapDrop\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es) => HyperView OverlapDrop es where\n  data Action OverlapDrop\n    = GetTimeDrop\n    deriving (Generic, ViewAction)\n\n  -- this is the default, not necessary to specify\n  -- type Concurrency OverlapDrop = Drop\n\n  update GetTimeDrop = do\n    t <- getTimeSlowly\n    pure $ viewTimeDrop (Just t)\n\nviewTimeDrop :: Maybe UTCTime -> View OverlapDrop ()\nviewTimeDrop = viewTime GetTimeDrop \"Drop\"\n\n-- Concurrency = Replace  --------------------------\n\ndata OverlapReplace = OverlapReplace\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es) => HyperView OverlapReplace es where\n  data Action OverlapReplace\n    = GetTimeReplace\n    deriving (Generic, ViewAction)\n\n  type Concurrency OverlapReplace = Replace\n\n  update GetTimeReplace = do\n    t <- getTimeSlowly\n    pure $ viewTimeReplace (Just t)\n\nviewTimeReplace :: Maybe UTCTime -> View OverlapReplace ()\nviewTimeReplace = viewTime GetTimeReplace \"Replace\"\n\n-- Utilities -----------------------------------------------\n\ngetTimeSlowly :: (Debug :> es) => Eff es UTCTime\ngetTimeSlowly = do\n  delay 2000\n  systemTime\n\nviewTime :: (ViewAction (Action id)) => Action id -> Text -> Maybe UTCTime -> View id ()\nviewTime runTime loadLbl mtime = do\n  row ~ gap 10 $ do\n    button runTime ~ btn $ text loadLbl\n    Loader.loading\n    case mtime of\n      Nothing -> none\n      Just t -> el ~ whenLoading (display None) $ text $ pack $ show t\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Concurrency/Polling.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Polling where\n\nimport App.Docs\nimport Data.Text (pack)\nimport Effectful\nimport Example.Effects.Debug\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\n-----------------------------------------------------------\n-- Simple Polling\n-----------------------------------------------------------\n\ndata Poller = Poller\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es) => HyperView Poller es where\n  data Action Poller\n    = Reload Int\n    | Stop\n    | Pause Int\n    deriving (Generic, ViewAction)\n\n  -- to stop, return a view without an onLoad\n  update (Pause n) = do\n    pure $ viewPaused n\n  update Stop = do\n    pure viewStopped\n  update (Reload n) = do\n    pure $ viewPoll n\n\nviewInit :: View Poller ()\nviewInit = do\n  row $ do\n    button (Reload 1) \"Start Polling\" ~ btn\n\nviewStopped :: View Poller ()\nviewStopped = do\n  row $ do\n    button (Reload 1) \"Restart Polling\" ~ btn\n\nviewPaused :: Int -> View Poller ()\nviewPaused n = do\n  col ~ gap 10 $ do\n    row $ do\n      button (Reload n) \"Resume\" ~ btn\n    viewStatus n\n\nviewPoll :: Int -> View Poller ()\nviewPoll n = do\n  -- reload every 200ms + round trip delay\n  col @ onLoad (Reload (n + 1)) 250 ~ gap 10 $ do\n    row ~ gap 5 $ do\n      button (Pause n) \"Pause\" ~ btn\n      button Stop \"Stop\" ~ btn\n    viewStatus n\n\nviewStatus :: Int -> View Poller ()\nviewStatus n = do\n  el $ do\n    text \"Polling... \"\n    text $ pack $ show n\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Concurrency/Progress.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Concurrency.Progress where\n\nimport App.Docs\nimport Control.Monad (when)\nimport Data.Text (pack)\nimport Effectful\nimport Example.Colors\nimport Example.Concurrency.Tasks\nimport Example.Effects.Debug\nimport Example.View.Inputs (progressBar)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.Effect.GenRandom\n\n-----------------------------------------------------------\n-- Overlapping Progress Bars\n-----------------------------------------------------------\n\ntype PercentPerTick = Int\n\ndata Progress = Progress TaskId\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es, GenRandom :> es) => HyperView Progress es where\n  data Action Progress\n    = GoProgress PercentPerTick\n    deriving (Generic, ViewAction)\n\n  update (GoProgress progPerTick) = do\n    _ <- tick 0\n    pure $ viewProgress 100\n   where\n    tick current = do\n      -- pretend we did some work\n      -- this will not block other hyperviews from updating\n      delay 50\n      let total = current + progPerTick\n\n      when (total < 100) $ do\n        pushUpdate $ viewProgress total\n        tick total\n\nviewProgressLoad :: PercentPerTick -> View Progress ()\nviewProgressLoad p = el @ onLoad (GoProgress p) 50 $ none\n\nviewProgress :: Int -> View Progress ()\nviewProgress prg\n  | prg >= 100 = viewComplete\n  | otherwise = viewUpdating\n where\n  viewComplete = do\n    row ~ bg Success . color White . pad 5 $ \"Complete\"\n\n  viewUpdating = do\n    let pct = fromIntegral prg / 100\n    Progress taskId <- viewId\n    progressBar pct $ do\n      el ~ grow $ text $ \"Task\" <> pack (show taskId)\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Concurrency/Tasks.hs",
    "content": "module Example.Concurrency.Tasks where\n\nimport Data.Text (Text, pack)\nimport Effectful\nimport Example.Effects.Debug\nimport Web.Hyperbole.Effect.GenRandom\n\n-- Fake Tasks Effect ----------------------------------------\n\ntype TaskId = Int\n\ndata Task = Task\n  { taskId :: TaskId\n  , details :: Text\n  }\n\npretendLoadTask :: (Debug :> es, GenRandom :> es) => TaskId -> Eff es Task\npretendLoadTask taskId = do\n  randomDelay <- genRandom (100, 1000)\n  delay randomDelay\n\n  pure $ Task taskId $ pack (show taskId)\n\npretendTasks :: [TaskId]\npretendTasks = [1 .. 30]\n"
  },
  {
    "path": "demo/Example/Contact.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Contact where\n\nimport App.Route (UserId)\nimport App.Route qualified as Route\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions\nimport Data.Text (Text, pack)\nimport App.Docs\nimport Effectful\nimport Effectful.Reader.Dynamic\nimport Example.Colors\nimport Example.Effects.Debug\nimport Example.Effects.Users (User (..), Users)\nimport Example.Effects.Users qualified as Users\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\n-- Example adding a reader context to the page, based on an argument from the AppRoute\nresponse :: (Hyperbole :> es, Users :> es, Debug :> es) => UserId -> Eff es Response\nresponse uid = runReader uid $ runPage page\n\n-- The page assumes all effects have been added\npage\n  :: forall es\n   . (Hyperbole :> es, Users :> es, Debug :> es, Reader UserId :> es)\n  => Page es '[Contact]\npage = do\n  uid <- ask\n  u <- Users.find uid\n  pure $ layout (Route.Contacts Route.ContactsAll) $ do\n    section' \"Contact\" $ do\n      hyper (Contact uid) $ contactView u\n\n-- Contact ----------------------------------------------------\n\ndata Contact = Contact UserId\n  deriving (Generic, ViewId)\n\ninstance (Users :> es, Debug :> es) => HyperView Contact es where\n  data Action Contact\n    = Edit\n    | Save\n    | ViewContact\n    deriving (Generic, ViewAction)\n\n  update action = do\n    -- No matter which action we are performing, let's look up the user to make sure it exists\n    Contact uid <- viewId\n    u <- Users.find uid\n    case action of\n      ViewContact -> do\n        pure $ contactView u\n      Edit -> do\n        pure $ contactEditView u\n      Save -> do\n        delay 1000\n        unew <- parseUser uid\n        Users.save unew\n        pure $ contactView unew\n\ndata ContactForm f = ContactForm\n  { firstName :: Field f Text\n  , lastName :: Field f Text\n  , age :: Field f Int\n  , info :: Field f Text\n  }\n  deriving (Generic, FromFormF, GenFields FieldName, GenFields Maybe)\n\nparseUser :: (Hyperbole :> es) => Int -> Eff es User\nparseUser uid = do\n  ContactForm{firstName, lastName, age, info} <- formData @(ContactForm Identity)\n  pure User{id = uid, isActive = True, firstName, lastName, age, info}\n\ncontactView :: User -> View Contact ()\ncontactView = contactView' Edit\n\ncontactView' :: (ViewId c, ViewAction (Action c)) => Action c -> User -> View c ()\ncontactView' edit u = do\n  col ~ gap 10 $ do\n    row ~ fld $ do\n      el (text \"First Name:\")\n      text u.firstName\n\n    row ~ fld $ do\n      el (text \"Last Name:\")\n      text u.lastName\n\n    row ~ fld $ do\n      el (text \"Age:\")\n      text (cs $ show u.age)\n\n    row ~ fld $ do\n      el (text \"Info:\")\n      text u.info\n\n    row ~ fld $ do\n      el (text \"Active:\")\n      text (cs $ show u.isActive)\n\n    button edit \"Edit\" ~ btn\n where\n  fld = gap 10\n\ncontactEditView :: User -> View Contact ()\ncontactEditView u = do\n  el contactLoading ~ display None . whenLoading flexCol\n  el (contactEdit ViewContact Save u) ~ whenLoading (display None)\n\ncontactEdit :: (ViewId c, ViewAction (Action c)) => Action c -> Action c -> User -> View c ()\ncontactEdit onView onSave u = do\n  col ~ gap 10 $ do\n    contactForm onSave contactFromUser\n    button onView (text \"Cancel\") ~ Style.btnLight\n where\n  contactFromUser :: ContactForm Maybe\n  contactFromUser =\n    ContactForm\n      { firstName = Just u.firstName\n      , lastName = Just u.lastName\n      , age = Just u.age\n      , info = Just u.info\n      }\n\ncontactForm :: (ViewId id, ViewAction (Action id)) => Action id -> ContactForm Maybe -> View id ()\ncontactForm onSubmit c = do\n  let f = fieldNames @ContactForm\n  form onSubmit ~ gap 10 $ do\n    field f.firstName ~ fld $ do\n      label $ do\n        text \"First Name:\"\n        input Name @ value (fromMaybe \"\" c.firstName) ~ Style.input\n\n    field f.lastName ~ fld $ do\n      label $ do\n        text \"Last Name:\"\n        input Name @ value (fromMaybe \"\" c.lastName) ~ Style.input\n\n    field f.info ~ fld $ do\n      label $ do\n        text \"Info:\"\n        textarea c.info @ value (fromMaybe \"\" c.info) ~ Style.input\n\n    field f.age ~ fld $ do\n      label $ do\n        text \"Age:\"\n        input Number @ value (maybe \"\" (pack . show) c.age) ~ inp\n\n    submit \"Submit\" ~ btn\n where\n  fld :: (Styleable a) => CSS a -> CSS a\n  fld = flexRow . gap 10\n  inp = Style.input\n\ncontactLoading :: View id ()\ncontactLoading = el ~ (bg Warning . pad 10) $ \"Loading...\"\n"
  },
  {
    "path": "demo/Example/Contacts.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Contacts where\n\nimport App.Docs\nimport App.Route (UserId)\nimport App.Route qualified as Route\nimport Control.Monad (forM_)\nimport Effectful\nimport Example.Colors\nimport Example.Contact (ContactForm, contactForm, contactLoading, contactView', parseUser)\nimport Example.Contact qualified as Contact\nimport Example.Effects.Debug\nimport Example.Effects.Users (User (..), Users)\nimport Example.Effects.Users qualified as Users\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn, btn', btnLight)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage\n  :: forall es\n   . (Hyperbole :> es, Users :> es, Debug :> es)\n  => Page es '[Contacts, InlineContact, NewContact]\npage = do\n  us <- Users.all\n  pure $ layout (Route.Contacts Route.ContactsAll) $ do\n    example $(moduleSource) $ do\n      hyper Contacts $ allContactsView Nothing us\n\n-- Contacts ----------------------------------------------\n\ndata Contacts = Contacts\n  deriving (Generic, ViewId)\n\ndata Filter\n  = Active\n  | Inactive\n  deriving (Eq, Show, Read, Generic, ToJSON, FromJSON, ToParam, FromParam)\n\ninstance (Users :> es, Debug :> es) => HyperView Contacts es where\n  data Action Contacts\n    = Reload (Maybe Filter)\n    | AddUser\n    | DeleteUser UserId\n    deriving (Generic, ViewAction)\n\n  type Require Contacts = '[InlineContact, NewContact]\n\n  update = \\case\n    Reload mf -> do\n      us <- Users.all\n      pure $ allContactsView mf us\n    AddUser -> do\n      uid <- Users.nextId\n      u <- parseUser uid\n      Users.save u\n      us <- Users.all\n      pure $ allContactsView Nothing us\n    DeleteUser uid -> do\n      Users.delete uid\n      us <- Users.all\n      pure $ allContactsView Nothing us\n\n-- TODO: get the form to close when submitted\n\nallContactsView :: Maybe Filter -> [User] -> View Contacts ()\nallContactsView fil us = col ~ gap 20 $ do\n  row ~ gap 10 $ do\n    el ~ pad 10 $ \"Filter: \"\n    dropdown Reload fil $ do\n      option Nothing \"\"\n      option (Just Active) \"Active!\"\n      option (Just Inactive) \"Inactive\"\n\n  row ~ gap 10 $ do\n    let filtered = filter (filterUsers fil) us\n    forM_ filtered $ \\u -> do\n      el ~ border 1 . pad 10 $ do\n        hyper (InlineContact u.id) $ contactView u\n        row $ do\n          space\n          route (Route.Contacts $ Route.Contact u.id) \"details\" ~ Style.link\n\n  row ~ gap 10 $ do\n    button (Reload Nothing) ~ Style.btnLight $ \"Reload\"\n    target (InlineContact 2) () $ button Edit ~ Style.btnLight $ \"Edit Sara\"\n\n  hyper NewContact newContactButton\n where\n  filterUsers Nothing _ = True\n  filterUsers (Just Active) u = u.isActive\n  filterUsers (Just Inactive) u = not u.isActive\n\n-- New Contact Form / Button ----------------------------------\n-- Note that it is easier to nest hyperviews here because NewContact has sufficiently different state\n--   * It doesn't need to know the users\n--   * It DOES need to track it's open / close state\n--   * We use target to submit the form to the Contacts parent view\n\ndata NewContact = NewContact\n  deriving (Generic, ViewId)\n\ninstance (Users :> es) => HyperView NewContact es where\n  data Action NewContact\n    = ShowForm\n    | CloseForm\n    deriving (Generic, ViewAction)\n\n  type Require NewContact = '[Contacts]\n\n  update action =\n    case action of\n      ShowForm -> pure newContactForm\n      CloseForm -> pure newContactButton\n\nnewContactButton :: View NewContact ()\nnewContactButton = do\n  button ShowForm ~ btn $ \"Add Contact\"\n\nnewContactForm :: View NewContact ()\nnewContactForm = do\n  row ~ pad 10 . gap 10 . border 1 $ do\n    target Contacts () $ do\n      contactForm AddUser (genFields :: ContactForm Maybe)\n    col $ do\n      space\n      button CloseForm ~ btnLight $ \"Cancel\"\n\n-- Reuse Contact View ----------------------------------\n-- We want to use the same view as Example.Contact, but customize the edit view to have a delete button\n-- Note that we re-implement the actions and the handler\n-- Just create functions to deduplicate code and use them here\n\ndata InlineContact = InlineContact UserId\n  deriving (Generic, ViewId)\n\ninstance (Users :> es, Debug :> es) => HyperView InlineContact es where\n  data Action InlineContact\n    = Edit\n    | ViewContact\n    | Save\n    deriving (Generic, ViewAction)\n\n  type Require InlineContact = '[Contacts]\n\n  update a = do\n    InlineContact uid <- viewId\n    u <- Users.find uid\n    case a of\n      ViewContact ->\n        pure $ contactView u\n      Edit ->\n        pure $ contactEdit u\n      Save -> do\n        delay 1000\n        unew <- parseUser uid\n        Users.save unew\n        pure $ contactView unew\n\n-- See how we reuse the contactView' from Example.Contact\ncontactView :: User -> View InlineContact ()\ncontactView = contactView' Edit\n\n-- See how we reuse the contactEdit' and contactLoading from Example.Contact\ncontactEdit :: User -> View InlineContact ()\ncontactEdit u = do\n  el ~ (display None . whenLoading flexCol) $ contactLoading\n  col ~ (whenLoading (display None) . gap 10) $ do\n    Contact.contactEdit ViewContact Save u\n    target Contacts () $ button (DeleteUser u.id) ~ btn' Danger . pad (XY 10 0) $ text \"Delete\"\n"
  },
  {
    "path": "demo/Example/Counter.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Counter where\n\nimport Data.Text (pack)\nimport Effectful\nimport Example.Style.Cyber as Style\nimport Web.Atomic.CSS\nimport Web.Hyperbole as Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[Counter]\npage = do\n  pure $ hyper Counter (viewCount 0)\n\ndata Counter = Counter\n  deriving (Generic, ViewId)\n\ninstance HyperView Counter es where\n  data Action Counter\n    = Increment Int\n    | Decrement Int\n    deriving (Generic, ViewAction)\n\n  update (Increment n) = do\n    pure $ viewCount (n + 1)\n  update (Decrement n) = do\n    pure $ viewCount (n - 1)\n\nviewCount :: Int -> View Counter ()\nviewCount n = row $ do\n  col ~ gap 10 $ do\n    el ~ dataFeature $ text $ pack $ show n\n    row ~ gap 10 $ do\n      button (Decrement n) \"Decrement\" ~ Style.btn\n      button (Increment n) \"Increment\" ~ Style.btn\n"
  },
  {
    "path": "demo/Example/Data/ProgrammingLanguage.hs",
    "content": "{-# LANGUAGE DerivingVia #-}\n\nmodule Example.Data.ProgrammingLanguage where\n\nimport Data.Text (Text, isInfixOf, toLower)\nimport Web.Hyperbole\n\ndata ProgrammingLanguage = ProgrammingLanguage\n  { family :: LanguageFamily\n  , name :: Text\n  , features :: [TypeFeature]\n  , description :: Text\n  }\n  deriving (Generic, ToParam, FromParam)\ninstance Eq ProgrammingLanguage where\n  p1 == p2 = p1.name == p2.name\n\ndata LanguageFamily\n  = Functional\n  | ObjectOriented\n  deriving (Eq, Show, ToJSON, FromJSON, Ord, Generic, ToParam, FromParam)\n\ndata TypeFeature\n  = Dynamic\n  | Typed\n  | Generics\n  | TypeClasses\n  | TypeFamilies\n  deriving (Eq, Show, ToJSON, FromJSON, Generic, ToParam, FromParam)\n\nisMatchLanguage :: Text -> ProgrammingLanguage -> Bool\nisMatchLanguage term p =\n  isInfixOf (toLower term) . toLower $ p.name\n\nallLanguages :: [ProgrammingLanguage]\nallLanguages =\n  [ ProgrammingLanguage ObjectOriented \"JavaScript\" [Dynamic] \"A versatile scripting language mainly used for web development.\"\n  , ProgrammingLanguage ObjectOriented \"Java\" [Typed] \"A robust, platform-independent language commonly used for enterprise applications.\"\n  , ProgrammingLanguage ObjectOriented \"TypeScript\" [Typed, Generics] \"A superset of JavaScript that adds static typing.\"\n  , ProgrammingLanguage ObjectOriented \"Python\" [Dynamic] \"A beginner-friendly language with a wide range of applications, from web to data science.\"\n  , ProgrammingLanguage ObjectOriented \"PHP\" [Dynamic] \"A server-side scripting language primarily used for web development.\"\n  , ProgrammingLanguage ObjectOriented \"Go\" [Typed, Generics] \"A statically typed, compiled language designed for simplicity and efficiency.\"\n  , ProgrammingLanguage ObjectOriented \"C++\" [Typed] \"A powerful language for system programming, game development, and high-performance applications.\"\n  , ProgrammingLanguage ObjectOriented \"C#\" [Typed, Generics] \"A language developed by Microsoft, widely used for developing Windows and web applications.\"\n  , ProgrammingLanguage ObjectOriented \"Objective-C\" [Typed] \"A language used primarily for macOS and iOS application development before Swift.\"\n  , ProgrammingLanguage ObjectOriented \"Rust\" [Typed, Generics, TypeClasses, TypeFamilies] \"A memory-safe language focused on performance and reliability.\"\n  , ProgrammingLanguage ObjectOriented \"Ruby\" [Dynamic] \"A dynamic language known for its simplicity and used in web frameworks like Ruby on Rails.\"\n  , ProgrammingLanguage ObjectOriented \"Swift\" [Typed, Generics] \"A modern language for iOS and macOS application development.\"\n  , ProgrammingLanguage Functional \"Haskell\" [Typed, Generics, TypeClasses, TypeFamilies] \"An elegant functional language for those with excellent taste.\"\n  , ProgrammingLanguage Functional \"Elm\" [Typed, Generics] \"A functional language for building reliable web front-end applications.\"\n  , ProgrammingLanguage Functional \"Scheme\" [Dynamic] \"A minimalist, functional dialect of Lisp.\"\n  ]\n"
  },
  {
    "path": "demo/Example/DataLists/Autocomplete.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.DataLists.Autocomplete where\n\nimport App.Docs\nimport App.Route as Route\nimport Control.Monad (forM_)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Effectful\nimport Example.Colors\nimport Example.Data.ProgrammingLanguage (ProgrammingLanguage (..), allLanguages, isMatchLanguage)\nimport Example.DataLists.Filter as Filter (chosenView, clearButton, resultsTable)\nimport Example.View.Layout\nimport Safe (atMay)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Prelude hiding (even, odd)\n\npage :: (Hyperbole :> es) => Page es '[LiveSearch]\npage = do\n  pure $ layout (Data Autocomplete) $ do\n    el \"Create a serverside autocomplete with a combination of onInput and onKeyDown\"\n    example $(moduleSource) $ do\n      hyper LiveSearch $ liveSearchView allLanguages 0 \"\"\n\ndata LiveSearch = LiveSearch\n  deriving (Generic, ViewId)\n\ninstance (IOE :> es) => HyperView LiveSearch es where\n  data Action LiveSearch\n    = SearchTerm Int Text\n    | Select (Maybe ProgrammingLanguage)\n    deriving (Generic, ViewAction)\n\n  -- favor the latest thing typed\n  type Concurrency LiveSearch = Replace\n\n  update (SearchTerm current term) = do\n    pure $ liveSearchView allLanguages current term\n  update (Select Nothing) = do\n    pure $ liveSearchView allLanguages 0 \"\"\n  update (Select (Just lang)) = do\n    pure $ selectedView lang\n\nselectedView :: ProgrammingLanguage -> View LiveSearch ()\nselectedView selected = do\n  col ~ gap 10 $ do\n    Filter.chosenView selected\n\nliveSearchView :: [ProgrammingLanguage] -> Int -> Text -> View LiveSearch ()\nliveSearchView langs current term = do\n  col ~ gap 10 $ do\n    el ~ stack $ do\n      search (SearchTerm current) 250 @ searchKeys . placeholder \"search programming languages\" . value term . autofocus ~ border 1 . pad 10 . grow\n      Filter.clearButton (SearchTerm current) term\n      col ~ popup (TRBL 50 0 0 0) . shownIfMatches $ do\n        searchPopup matchedLanguages currentSearchLang\n    Filter.resultsTable (Select . Just) langs\n where\n  matchedLanguages = filter (isMatchLanguage term) langs\n\n  currentSearchLang = matchedLanguages `atMay` current\n\n  -- Only show the search popup if there is a search term and matchedLanguages\n  shownIfMatches =\n    if T.null term || null matchedLanguages then display None else flexCol\n\n  searchKeys =\n    onKeyDown Enter (Select currentSearchLang)\n      . onKeyDown ArrowDown (SearchTerm (current + 1) term)\n      . onKeyDown ArrowUp (SearchTerm (current - 1) term)\n\nsearchPopup :: [ProgrammingLanguage] -> Maybe ProgrammingLanguage -> View LiveSearch ()\nsearchPopup shownLangs highlighted = do\n  col ~ border 1 . bg White $ do\n    forM_ shownLangs $ \\lang -> do\n      button (Select (Just lang)) ~ hover (bg Light) . selected lang . pad 5 $ do\n        text lang.name\n where\n  selected l = if Just l == highlighted then bg Light else id\n"
  },
  {
    "path": "demo/Example/DataLists/DataTable.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.DataLists.DataTable where\n\nimport App.Docs\nimport App.Route as Route\nimport Data.List (sortOn)\nimport Data.Text (pack)\nimport Effectful\nimport Example.Data.ProgrammingLanguage (ProgrammingLanguage (..), allLanguages)\nimport Example.View.Layout\nimport Example.View.SortableTable (dataTable, sortBtn, sortColumn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Prelude hiding (even, odd)\n\n-- DataTable -> do\n--   el \"Complex reusable View Functions allow us to \"\n\npage :: (Hyperbole :> es) => Page es '[Languages]\npage = do\n  pure $ layout (Data SortableTable) $ do\n    el \"We can write view Functions that work in any view, like a dataTable\"\n    example $(moduleSource) $ do\n      hyper Languages $ languagesView Nothing allLanguages\n\ndata Languages = Languages\n  deriving (Generic, ViewId)\n\ndata SortField\n  = SortName\n  | SortDescription\n  | SortFamily\n  deriving (Show, Read, Eq, Generic, ToJSON, FromJSON, ToParam, FromParam)\n\ninstance HyperView Languages es where\n  data Action Languages\n    = SortOn SortField\n    deriving (Generic, ViewAction)\n\n  update (SortOn fld) = do\n    let sorted = sortOnField fld allLanguages\n    pure $ languagesView (Just fld) sorted\n\nsortOnField :: SortField -> [ProgrammingLanguage] -> [ProgrammingLanguage]\nsortOnField = \\case\n  SortName -> sortOn (.name)\n  SortDescription -> sortOn (.description)\n  SortFamily -> sortOn (.family)\n\nlanguagesView :: Maybe SortField -> [ProgrammingLanguage] -> View Languages ()\nlanguagesView fld langs =\n  table langs ~ dataTable $ do\n    sortColumn (sortBtn \"Language\" (SortOn SortName) (fld == Just SortName)) (.name)\n    sortColumn (sortBtn \"Family\" (SortOn SortFamily) (fld == Just SortFamily)) $ \\d -> pack $ show d.family\n    sortColumn (sortBtn \"Description\" (SortOn SortDescription) (fld == Just SortDescription)) (.description)\n"
  },
  {
    "path": "demo/Example/DataLists/Filter.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.DataLists.Filter where\n\nimport App.Docs\nimport App.Route as Route\nimport Data.Text (Text, pack)\nimport Effectful hiding (Dynamic)\nimport Example.Colors\nimport Example.Data.ProgrammingLanguage (LanguageFamily (..), ProgrammingLanguage (..), TypeFeature (..), allLanguages, isMatchLanguage)\nimport Example.View.Icon as Icon\nimport Example.View.Inputs (toggleCheckbox)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Prelude hiding (even, odd)\n\npage :: (Hyperbole :> es, IOE :> es) => Page es '[Languages]\npage = do\n  filters <- query\n  pure $ layout (Data Filter) $ do\n    el \"Incrementally search a list of data, storing parameters in the query string\"\n    example $(moduleSource) $ do\n      hyper Languages $ languagesView filters\n\ndata Languages = Languages\n  deriving (Generic, ViewId)\n\n-- Filters available from the query\n-- See Example.Data.ProgrammingLanguage\ndata Filters = Filters\n  { features :: [TypeFeature]\n  , family :: Maybe LanguageFamily\n  , term :: Text\n  }\n  deriving (Generic, Show, FromQuery, ToQuery)\n\ninstance (IOE :> es) => HyperView Languages es where\n  data Action Languages\n    = SearchTerm Text\n    | Select ProgrammingLanguage\n    | Feature TypeFeature Bool\n    | SetFamily (Maybe LanguageFamily)\n    deriving (Generic, ViewAction)\n\n  -- favor the latest thing entered / typed\n  type Concurrency Languages = Replace\n\n  update = \\case\n    Select lang -> do\n      pure $ chosenView lang\n    SearchTerm term -> do\n      filters <- modFilters $ \\f -> f{term}\n      pure $ languagesView filters\n    Feature feature selected -> do\n      filters <- modFilters $ \\f -> setFeatures feature selected f\n      pure $ languagesView filters\n    SetFamily f -> do\n      filters <- modFilters $ \\Filters{features, term} -> Filters{family = f, features, term}\n      pure $ languagesView filters\n   where\n    setFeatures feature selected Filters{term, family, features} =\n      let features' = if selected then addFeature feature features else delFeature feature features\n       in Filters{term, family, features = features'}\n    addFeature f fs\n      | f `elem` fs = fs\n      | otherwise = f : fs\n    delFeature feature =\n      filter (/= feature)\n    modFilters f = do\n      filts <- query\n      let filts' = f filts\n      setQuery filts'\n      pure filts'\n\n-- apply our filters, return any languages that match\nfilterLanguages :: Filters -> [ProgrammingLanguage]\nfilterLanguages filts =\n  filter match allLanguages\n where\n  match lang =\n    isMatchLanguage filts.term lang\n      && matchFamily filts.family lang\n      && matchFeatures filts.features lang\n  matchFamily Nothing _ = True\n  matchFamily (Just fam) lang = lang.family == fam\n  matchFeatures feats lang =\n    all (\\f -> f `elem` lang.features) feats\n\nlanguagesView :: Filters -> View Languages ()\nlanguagesView filters = do\n  let matched = filterLanguages filters\n  col ~ gap 10 . grow $ do\n    filtersView filters\n    resultsTable Select matched\n\nfiltersView :: Filters -> View Languages ()\nfiltersView filters = do\n  el ~ stack . grow $ do\n    search SearchTerm 250 @ placeholder \"filter programming languages\" . value filters.term . autofocus ~ border 1 . pad 10\n    clearButton SearchTerm filters.term\n\n  row $ do\n    col ~ gap 5 $ do\n      el ~ bold $ \"Language Family\"\n      familyDropdown filters\n    space\n    col ~ gap 5 $ do\n      el ~ bold $ \"Type System Features\"\n      feature Dynamic\n      feature Typed\n      feature Generics\n      feature TypeClasses\n      feature TypeFamilies\n where\n  feature f =\n    row ~ gap 10 $ do\n      toggleCheckbox (Feature f) (f `elem` filters.features)\n      el $ text (featureName f)\n\n  featureName f = pack $ show f\n\nfamilyDropdown :: Filters -> View Languages ()\nfamilyDropdown filters =\n  dropdown SetFamily filters.family ~ border 1 . pad 10 $ do\n    option Nothing \"Any\"\n    option (Just ObjectOriented) \"Object Oriented\"\n    option (Just Functional) \"Functional\"\n\nclearButton :: (ViewAction (Action id)) => (Text -> Action id) -> Text -> View id ()\nclearButton clear term =\n  el ~ popup (R 0) . pad 10 . showClearBtn $ do\n    button (clear \"\") ~ width 24 . hover (color PrimaryLight) $ Icon.xCircle\n where\n  showClearBtn =\n    case term of\n      \"\" -> display None\n      _ -> id\n\nchosenView :: ProgrammingLanguage -> View c ()\nchosenView lang = do\n  row ~ gap 10 $ do\n    el \"You chose:\"\n    el $ text lang.name\n  el ~ (if lang.name == \"Haskell\" then id else display None) $ \"You are as wise as you are attractive\"\n\nresultsTable :: (ViewAction (Action id)) => (ProgrammingLanguage -> Action id) -> [ProgrammingLanguage] -> View id ()\nresultsTable onSelect langs = do\n  col ~ gap 15 $ do\n    mapM_ languageRow langs\n where\n  languageRow lang = do\n    col ~ gap 5 $ do\n      row ~ gap 5 $ do\n        el ~ bold $ text lang.name\n        space\n        button (onSelect lang) ~ pad (XY 10 2) . border 1 . hover (bg GrayLight) . rows $ \"Select\"\n\n      row $ viewFamily lang.family\n\n      row ~ gap 5 $ do\n        el $ text lang.description\n\n  rows = textAlign AlignCenter . border 1 . borderColor GrayLight\n\nviewFamily :: LanguageFamily -> View c ()\nviewFamily fam = do\n  el ~ bg Light . pad (XY 10 2) . fontSize 16 . textAlign AlignCenter $ family fam\n where\n  family Functional = \"Functional\"\n  family ObjectOriented = \"Object Oriented\"\n"
  },
  {
    "path": "demo/Example/DataLists/LoadMore.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.DataLists.LoadMore where\n\nimport App.Docs\nimport App.Route as Route\nimport Effectful\nimport Example.Data.ProgrammingLanguage (ProgrammingLanguage (..), allLanguages)\nimport Example.DataLists.Filter (viewFamily)\nimport Example.Style.Cyber (btn)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Prelude hiding (even, odd)\n\npage :: (Hyperbole :> es) => Page es '[Languages]\npage = do\n  ls <- loadNextLanguages 0\n  pure $ layout (Data LoadMore) $ do\n    el \"Progressively load more data\"\n    example $(moduleSource) $ do\n      hyper (Languages 0) $ languagesView ls\n\ntype Offset = Int\n\n-- fake database load of next N language\nloadNextLanguages :: Offset -> Eff es [ProgrammingLanguage]\nloadNextLanguages offset =\n  pure $ fmap snd $ filter isInPage $ zip [0 ..] allLanguages\n where\n  isInPage (n, _) = n >= offset && n < offset + nextLanguagesPageSize\n\nnextLanguagesPageSize :: Int\nnextLanguagesPageSize = 4\n\ndata Languages = Languages Offset\n  deriving (Generic, ViewId)\n\ninstance HyperView Languages es where\n  data Action Languages\n    = Load\n    deriving (Generic, ViewAction)\n\n  update Load = do\n    Languages offset <- viewId\n    ls <- loadNextLanguages offset\n    pure $ languagesView ls\n\nlanguagesView :: [ProgrammingLanguage] -> View Languages ()\nlanguagesView ls = do\n  col ~ gap 20 $ do\n    mapM_ languageView ls\n  col ~ pad (TRBL 20 0 0 0) $ do\n    nextLanguages ls\n\nnextLanguages :: [ProgrammingLanguage] -> View Languages ()\nnextLanguages ls\n  | length ls < nextLanguagesPageSize = pure ()\n  | otherwise = do\n      Languages off <- viewId\n      hyper (Languages (off + nextLanguagesPageSize)) $ do\n        button Load ~ btn $ \"Load More\"\n\nlanguageView :: ProgrammingLanguage -> View Languages ()\nlanguageView lang = do\n  col ~ gap 6 $ do\n    row $ do\n      el ~ bold $ text lang.name\n      space\n      row $ viewFamily lang.family\n    el $ text lang.description\n"
  },
  {
    "path": "demo/Example/Docs/App.hs",
    "content": "module Example.Docs.App where\n\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Concurrent\nimport Effectful.Dispatch.Dynamic (send)\nimport Effectful.Reader.Dynamic\nimport Example.Docs.Page.Messages qualified as Messages\nimport Example.Docs.Page.Users qualified as Users\nimport Example.Docs.SideEffects as SideEffects\nimport Example.Effects.Users (User, Users (..))\nimport Web.Hyperbole\nimport Web.Hyperbole.Effect.Response (view)\n\ndocumentHead :: View DocumentHead ()\ndocumentHead = do\n  title \"My Website\"\n  script' scriptEmbed\n  style cssEmbed\n  script \"custom.js\"\n\nrouter :: (Hyperbole :> es) => AppRoute -> Eff es Response\nrouter Messages = runPage Messages.page\nrouter (User cid) = runPage $ Users.page cid\nrouter Main = do\n  pure $ view $ do\n    el \"click a link below to visit a page\"\n    route Messages \"Messages\"\n    route (User 1) \"User 1\"\n    route (User 2) \"User 2\"\n\ntype UserId = Int\n\ndata AppRoute\n  = Main\n  | Messages\n  | User UserId\n  deriving (Eq, Generic)\n\ninstance Route AppRoute where\n  baseRoute = Just Main\n\n\nfindUser :: (Hyperbole :> es, Users :> es) => Int -> Eff es User\nfindUser uid = do\n  mu <- send (LoadUser uid)\n  maybe notFound pure mu\n\nuserPage :: (Hyperbole :> es, Users :> es) => Page es '[]\nuserPage = do\n  user <- findUser 100\n\n  -- skipped if user not found\n  pure $ userView user\n\nuserView :: User -> View c ()\nuserView _ = none\n\napp :: Application\napp = liveApp (document documentHead) (routeRequest router)\n\ndata AppConfig = AppConfig\n\nrunApp :: (Hyperbole :> es, IOE :> es) => AppConfig -> Eff (Reader AppConfig : Concurrent : es) a -> Eff es a\nrunApp config = runConcurrent . runReader config\n\napp' :: AppConfig -> Application\napp' config = liveApp (document documentHead) (runApp config $ routeRequest router')\n\nrouter' :: (Hyperbole :> es, Concurrent :> es) => AppRoute -> Eff es Response\nrouter' Messages = runReader @Text \"Secret Message!\" $ runPage SideEffects.page\nrouter' (User cid) = runPage $ Users.page cid\nrouter' Main = pure $ view \"...\"\n"
  },
  {
    "path": "demo/Example/Docs/BasicPage.hs",
    "content": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n\nmodule Example.Docs.BasicPage where\n\nimport Data.Text (Text)\nimport Web.Hyperbole\n\nmain :: IO ()\nmain = do\n  run 3000 $ liveApp quickStartDocument (runPage hello)\n\nhello :: Page es '[]\nhello = do\n  pure $ el \"Hello World\"\n\nmessageView :: Text -> View context ()\nmessageView msg =\n  el $ text msg\n\nhelloWorld :: View context ()\nhelloWorld =\n  el \"Hello World\"\n\npage :: Page es '[]\npage = do\n  pure $ messageView \"Hello World\"\n"
  },
  {
    "path": "demo/Example/Docs/CSS.hs",
    "content": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n{-# OPTIONS_GHC -Wno-unused-binds #-}\n{-# OPTIONS_GHC -Wno-unused-top-binds #-}\n\nmodule Example.Docs.CSS where\n\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nexample = do\n  col $ do\n    el ~ h3 $ \"My Page\"\n    el ~ btn $ \"Hover Me\"\n where\n  header = bold\n  h1 = header . fontSize 32\n  h2 = header . fontSize 24\n  h3 = header . fontSize 18\n\n  btn =\n    pad 10 . border 1 . pointer . hover (bold . border 2)\n"
  },
  {
    "path": "demo/Example/Docs/Client.hs",
    "content": "module Example.Docs.Client where\n\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[]\npage = do\n  pageTitle \"My Page Title\"\n  pure $ el \"Hello World\"\n"
  },
  {
    "path": "demo/Example/Docs/Component.hs",
    "content": "module Example.Docs.Component where\n\nimport Data.Text (Text)\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nstyledButton :: (ViewAction (Action id)) => Action id -> Text -> View id ()\nstyledButton clickAction lbl = do\n  button clickAction ~ btn $ text lbl\n where\n  btn = pad 10 . bg Primary . hover (bg PrimaryLight) . rounded 5\n"
  },
  {
    "path": "demo/Example/Docs/Encoding.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.Encoding where\n\nimport Data.Text (Text)\nimport Web.Hyperbole\n\ndata Filters = Filters\n  { active :: Bool\n  , term :: Text\n  }\n  deriving (Generic, Eq, FromQuery, ToQuery)\n"
  },
  {
    "path": "demo/Example/Docs/Interactive.hs",
    "content": "module Example.Docs.Interactive where\n\nimport Example.Simple\nimport Web.Hyperbole\n\npage :: Page es '[Message]\npage = do\n  pure $ do\n    el \"Unchanging Header\"\n    hyper Message1 $ messageView \"Hello\"\n    hyper Message2 $ messageView \"World\"\n"
  },
  {
    "path": "demo/Example/Docs/MultiPage.hs",
    "content": "{-# OPTIONS_GHC -Wno-missing-signatures #-}\n\nmodule Example.Docs.MultiPage where\n\nimport Example.Docs.Interactive qualified as Message\nimport Example.Docs.MultiView qualified as Counter\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata AppRoute\n  = Message -- /message\n  | Counter -- /counter\n  deriving (Generic, Eq, Route)\n\nmain = do\n  run 3000 $ do\n    liveApp quickStartDocument (routeRequest router)\n where\n  router Message = runPage Message.page\n  router Counter = runPage Counter.page\n\nmenu :: View c ()\nmenu = do\n  route Message \"Link to /message\"\n  route Counter \"Link to /counter\"\n\nexampleLayout :: View c () -> View c ()\nexampleLayout contents = do\n  col ~ grow $ do\n    el ~ border 1 $ \"My Website Header\"\n    row $ do\n      menu\n      contents\n\nexamplePage :: Page es '[]\nexamplePage = do\n  pure $ exampleLayout $ do\n    el \"page contents\"\n"
  },
  {
    "path": "demo/Example/Docs/MultiView.hs",
    "content": "module Example.Docs.MultiView where\n\nimport Example.Counter (Counter (..), viewCount)\nimport Example.Simple (Message (..), messageView)\nimport Web.Hyperbole\n\npage :: Page es [Message, Counter]\npage = do\n  pure $ do\n    hyper Message1 $ messageView \"Hello\"\n    hyper Message2 $ messageView \"World\"\n    hyper Counter $ viewCount 0\n"
  },
  {
    "path": "demo/Example/Docs/Nested.hs",
    "content": "module Example.Docs.Nested where\n\nimport Control.Monad (forM_)\nimport Data.Text (Text)\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[AllTodos, TodoItem]\npage = do\n  pure $ do\n    hyper AllTodos $ todosView allTodos\n where\n  allTodos = [todo \"One\", todo \"Two\", todo \" Three\"]\n  todo t = Todo t False\n\ndata Todo = Todo\n  { task :: Text\n  , completed :: Bool\n  }\n  deriving (Generic, ToParam, FromParam)\n\ndata AllTodos = AllTodos\n  deriving (Generic, ViewId)\n\ninstance HyperView AllTodos es where\n  type Require AllTodos = '[TodoItem]\n\n  data Action AllTodos\n    = AddTodo Text [Todo]\n    deriving (Generic, ViewAction)\n\n  update (AddTodo txt todos) = do\n    let new = Todo txt False : todos\n    pure $ todosView new\n\ntodosView :: [Todo] -> View AllTodos ()\ntodosView todos = do\n  forM_ todos $ \\todo -> do\n    hyper TodoItem $ todoView todo\n  button (AddTodo \"Shopping\" todos) \"Add Todo: Shopping\"\n\ndata TodoItem = TodoItem\n  deriving (Generic, ViewId)\n\ninstance HyperView TodoItem es where\n  data Action TodoItem\n    = Complete Todo\n    deriving (Generic, ViewAction)\n\n  update (Complete todo) = do\n    let new = todo{completed = True}\n    pure $ todoView new\n\ntodoView :: Todo -> View TodoItem ()\ntodoView todo = do\n  el (text todo.task)\n  button (Complete todo) \"Mark Completed\"\n"
  },
  {
    "path": "demo/Example/Docs/Nesting.hs",
    "content": "module Example.Docs.Nesting where\n\nimport Control.Monad (forM_)\nimport Example.Colors\nimport Example.Docs.UniqueViewId hiding (loadDummyItemIds)\nimport Example.Style.Cyber (btnLight)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: Page es '[ItemList, Item]\npage = do\n  itemIds <- loadDummyItemIds\n  pure $ hyper ItemList $ itemList itemIds\n\ndata ItemList = ItemList\n  deriving (Generic, ViewId)\n\ninstance HyperView ItemList es where\n  data Action ItemList = Reset\n    deriving (Generic, ViewAction)\n\n  type Require ItemList = '[Item]\n\n  update Reset = do\n    itemIds <- loadDummyItemIds\n    pure $ itemList itemIds\n\n-- need to load different item ids, because both examples are on the same documentation page!\nloadDummyItemIds :: Eff es [Int]\nloadDummyItemIds = pure [5 .. 9]\n\nitemList :: [Int] -> View ItemList ()\nitemList itemIds = do\n  row ~ gap 4 . color White $ do\n    forM_ itemIds $ \\itemId -> do\n      hyper (Item itemId) itemUnloaded\n    button Reset ~ btnLight $ \"Reset\"\n"
  },
  {
    "path": "demo/Example/Docs/Page/Messages.hs",
    "content": "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",
    "content": "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",
    "content": "module Example.Docs.Params where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Filters = Filters\n  { search :: Text\n  }\n  deriving (ToQuery, FromQuery, Generic)\n\npage :: (Hyperbole :> es) => Page es '[Todos]\npage = do\n  filters <- query @Filters\n  todos <- loadTodos filters\n  pure $ do\n    hyper Todos $ todosView todos\n\ndata Todos = Todos\n  deriving (Generic, ViewId)\n\ninstance HyperView Todos es where\n  data Action Todos\n    = SetSearch Text\n    deriving (Generic, ViewAction)\n\n  update (SetSearch term) = do\n    let filters = Filters term\n    setQuery filters\n    todos <- loadTodos filters\n    pure $ todosView todos\n\n-- Fake User effect\ndata Todo\n\nloadTodos :: Filters -> Eff es [Todo]\nloadTodos _ = pure []\n\n-- Fake Todo View\ntodosView :: [Todo] -> View Todos ()\ntodosView _ = none\n\npage' :: (Hyperbole :> es) => Page es '[Message]\npage' = do\n  msg <- param \"message\"\n  pure $ do\n    hyper Message $ messageView msg\n\nmessageView :: Text -> View Message ()\nmessageView m = do\n  el ~ bold $ text $ \"Message: \" <> m\n  button (SetMessage \"Goodbye\") ~ border 1 $ \"Say Goodbye\"\n\ndata Message = Message\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = SetMessage Text\n    deriving (Generic, ViewAction)\n\n  update (SetMessage msg) = do\n    setParam \"message\" msg\n    pure $ messageView msg\n"
  },
  {
    "path": "demo/Example/Docs/QueryMessage.hs",
    "content": "module Example.Docs.QueryMessage where\n\nimport Data.Maybe (fromMaybe)\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[Message]\npage = do\n  prm <- lookupParam \"msg\"\n  let msg = fromMaybe \"hello\" prm\n  pure $ do\n    hyper Message $ messageView msg\n\ndata Message = Message\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = Louder Text\n    deriving (Generic, ViewAction)\n\n  update (Louder msg) = do\n    let new = msg <> \"!\"\n    setParam \"msg\" new\n    pure $ messageView new\n\nmessageView :: Text -> View Message ()\nmessageView m = do\n  button (Louder m) ~ border 1 $ \"Louder\"\n  el ~ bold $ text $ \"Message: \" <> m\n"
  },
  {
    "path": "demo/Example/Docs/Sessions.hs",
    "content": "module Example.Docs.Sessions where\n\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata AppColor\n  = White\n  | Red\n  | Green\n  deriving (Show, Generic, ToParam, FromParam)\n\ninstance Default AppColor where\n  def = White\n\ninstance ToColor AppColor where\n  colorValue White = \"#FFF\"\n  colorValue Red = \"#F00\"\n  colorValue Green = \"#0F0\"\n\ndata Preferences = Preferences\n  { color :: AppColor\n  }\n  deriving (Generic, ToEncoded, FromEncoded, Session)\ninstance Default Preferences where\n  def = Preferences White\n\npage :: (Hyperbole :> es) => Page es '[Content]\npage = do\n  prefs <- session @Preferences\n  pure $ el ~ bg prefs.color $ \"Custom Background\"\n\ndata Content = Content\n  deriving (Generic, ViewId)\n\ninstance HyperView Content es where\n  data Action Content\n    = SetColor AppColor\n    deriving (Generic, ViewAction)\n\n  update (SetColor clr) = do\n    let prefs = Preferences clr\n    saveSession prefs\n    pure $ el ~ bg prefs.color $ \"Custom Background\"\n"
  },
  {
    "path": "demo/Example/Docs/SideEffects.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.SideEffects where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Effectful\nimport Effectful.Concurrent\nimport Effectful.Reader.Dynamic\nimport Example.Colors\nimport Example.Style.Cyber\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\n-- page :: (Hyperbole :> es, Concurrent :> es) => Page es '[]\n-- page = do\n--   threadDelay 1000\n--   let msg = fromMaybe \"hello\" prm\n--   pure $ do\n--     hyper Message $ messageView msg\n\n-- page :: (Hyperbole :> es, IOE :> es) => Page es '[Message]\n-- page = do\n--   prm <- lookupParam \"msg\"\n--   let msg = fromMaybe \"hello\" prm\n--   pure $ do\n--     hyper Message $ messageView msg\n\napp :: Application\napp = do\n  liveApp quickStartDocument $ do\n    runConcurrent . runReader @Text \"Secret!\" $\n      runPage page\n\npage :: (Hyperbole :> es, Concurrent :> es, Reader Text :> es) => Page es '[SlowReader]\npage = do\n  pure $ hyper SlowReader $ messageView \"...\"\n\ndata SlowReader = SlowReader\n  deriving (Generic, ViewId)\n\ninstance (Concurrent :> es, Reader Text :> es) => HyperView SlowReader es where\n  data Action SlowReader\n    = GetMessage\n    deriving (Generic, ViewAction)\n\n  update GetMessage = do\n    threadDelay 500000\n    msg <- ask\n    pure $ messageView msg\n\nmessageView :: Text -> View SlowReader ()\nmessageView m = do\n  el ~ bold . whenLoading (color SecondaryLight) $ text $ \"Message: \" <> m\n  button GetMessage ~ btn $ \"Get Message from Reader\"\n\n-- data Message = Message\n--   deriving (Generic, ViewId)\n--\n-- instance (IOE :> es) => HyperView Message es where\n--   data Action Message\n--     = Louder Text\n--     deriving (Generic, ViewAction)\n--\n--   update (Louder msg) = do\n--     let new = msg <> \"!\"\n--     setParam \"msg\" new\n--     pure $ messageView new\n--\n-- messageView :: Text -> View Message ()\n-- messageView m = do\n--   button (Louder m) ~ border 1 $ \"Louder\"\n--   el ~ bold $ text $ \"Message: \" <> m\n\ndata Titler = Titler\n  deriving (Generic, ViewId)\n\ninstance HyperView Titler es where\n  data Action Titler\n    = SetTitle Text\n    deriving (Generic, ViewAction)\n\n  update (SetTitle msg) = do\n    pageTitle msg\n    pure \"Check the title\"\n\ntitleView :: View Titler ()\ntitleView = do\n  button (SetTitle \"Hello\") ~ btn $ \"Set Title\"\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Docs/State.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.State where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nmessageView :: Text -> View Message ()\nmessageView m = do\n  button (Louder m) ~ border 1 $ \"Louder\"\n  el ~ bold $ text m\n\npage :: Page es '[Message]\npage = do\n  pure $ do\n    hyper Message $ messageView \"Hello\"\n\ndata Message = Message\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = Louder Text\n    deriving (Generic, ViewAction)\n\n  update (Louder m) = do\n    let new = m <> \"!\"\n    pure $ messageView new\n"
  },
  {
    "path": "demo/Example/Docs/UniqueViewId.hs",
    "content": "module Example.Docs.UniqueViewId where\n\nimport Control.Monad (forM_)\nimport Data.Text (Text, pack)\nimport Example.Colors\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: Page es '[Item]\npage = do\n  itemIds <- loadDummyItemIds\n  pure $ do\n    row ~ gap 4 $ do\n      forM_ itemIds $ \\uid -> do\n        hyper (Item uid) itemUnloaded\n\n-- Item ----------------------------------------------------------------\n\ntype UniqueId = Int\ndata Item = Item UniqueId\n  deriving (Generic, ViewId)\n\ninstance HyperView Item es where\n  data Action Item = Load\n    deriving (Generic, ViewAction)\n\n  update Load = do\n    Item uid <- viewId\n    item <- loadDummyItem uid\n    pure $ itemLoaded item\n\nitemUnloaded :: View Item ()\nitemUnloaded = do\n  Item uid <- viewId\n  button Load ~ btn $ text $ \"Load \" <> pack (show uid)\n\nitemLoaded :: Text -> View Item ()\nitemLoaded msg = do\n  el ~ bg SecondaryLight . color White . pad 10 $ text msg\n\n-- Fake Database ------------------------------------------------------\n\nloadDummyItem :: Int -> Eff es Text\nloadDummyItem n =\n  pure $ items !! n\n where\n  items = [\"zero\", \"one\", \"two\", \"three\", \"four\", \"five\", \"six\", \"seven\", \"eight\", \"nine\", \"ten\"]\n\nloadDummyItemIds :: Eff es [Int]\nloadDummyItemIds = pure [0 .. 4]\n\n\n"
  },
  {
    "path": "demo/Example/Docs/ViewFunctions.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Docs.ViewFunctions where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Example.Style.Cyber (btn)\nimport Example.View.Inputs (progressBar, toggleCheckbox)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: Page es '[Message]\npage = do\n  pure $ do\n    hyper VFMessage $ messageView \"Hello\"\n\ndata Message = VFMessage\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = SetMessage Text\n    deriving (Generic, ViewAction)\n\n  update (SetMessage t) =\n    pure $ messageView t\n\nmessageView :: Text -> View Message ()\nmessageView m = do\n  header m\n  messageButton \"Salutations!\"\n  messageButton \"Good Morning!\"\n  messageButton \"Goodbye\"\n\nmessageButton :: Text -> View Message ()\nmessageButton msg = do\n  button (SetMessage msg) ~ btn $ text $ \"Say \" <> msg\n\nheader :: Text -> View ctx ()\nheader txt = do\n  el ~ bold $ text txt\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\n-- Toggle Examples ----------------------------\n\ndata Toggler = Toggler\n  deriving (Generic, ViewId)\n\ninstance HyperView Toggler es where\n  data Action Toggler\n    = Toggle Bool\n    deriving (Generic, ViewAction)\n\n  update (Toggle b) =\n    -- do something with the data\n    pure $ toggler b\n\ntoggler :: Bool -> View Toggler ()\ntoggler b =\n  row ~ gap 10 $ do\n    toggleCheckbox Toggle b\n    text \"I am using view functions\"\n\n-- Progress Example ------------------------\n\ndata Progress = Progress\n  deriving (Generic, ViewId)\n\ninstance HyperView Progress es where\n  data Action Progress\n    = MakeProgress Float\n    deriving (Generic, ViewAction)\n\n  update (MakeProgress pct) =\n    pure $ workingHard (pct + 0.1)\n\nworkingHard :: Float -> View Progress ()\nworkingHard prog =\n  row ~ gap 10 $ do\n    button (MakeProgress prog) ~ btn $ \" + Progress\"\n    progressBar prog ~ grow $ do\n      el ~ grow . fontSize 18 $\n        if prog >= 1\n          then \"Done!\"\n          else \"Working...\"\n"
  },
  {
    "path": "demo/Example/Document.hs",
    "content": "module Example.Document where\n\nimport Web.Hyperbole\n\nmain :: IO ()\nmain = do\n  run 3000 $ liveApp (document documentHead) (runPage hello)\n\ndocumentHead :: View DocumentHead ()\ndocumentHead = do\n  title \"Best Website Ever\"\n  mobileFriendly\n  style cssEmbed\n  script' scriptEmbed\n  stylesheet \"/mysite.css\"\n\nhello :: Page es '[]\nhello = do\n  pure $ el \"Hello World\"\n"
  },
  {
    "path": "demo/Example/Effects/Debug.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.Effects.Debug\n  ( Milliseconds\n  , Debug (..)\n  , runDebugIO\n  , dump\n  , delay\n  , systemTime\n  , UTCTime\n  ) where\n\nimport Control.Concurrent (threadDelay)\nimport Data.String.Interpolate (i)\nimport Data.Time.Clock (UTCTime, getCurrentTime)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\n\ntype Milliseconds = Int\ndata Debug :: Effect where\n  Dump :: (Show a) => String -> a -> Debug m ()\n  Delay :: Milliseconds -> Debug m ()\n  Time :: Debug m UTCTime\n\ntype instance DispatchOf Debug = 'Dynamic\n\nrunDebugIO\n  :: (IOE :> es)\n  => Eff (Debug : es) a\n  -> Eff es a\nrunDebugIO = interpret $ \\_ -> \\case\n  Dump msg a -> do\n    liftIO $ putStrLn [i| [#{msg}] #{show a}|]\n  Delay ms -> liftIO $ threadDelay (ms * 1000)\n  Time -> liftIO getCurrentTime\n\ndump :: (Debug :> es, Show a) => String -> a -> Eff es ()\ndump msg a = send $ Dump msg a\n\ndelay :: (Debug :> es) => Milliseconds -> Eff es ()\ndelay n = send $ Delay n\n\nsystemTime :: (Debug :> es) => Eff es UTCTime\nsystemTime = send Time\n"
  },
  {
    "path": "demo/Example/Effects/Todos.hs",
    "content": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Effects.Todos where\n\nimport Data.Map (Map)\nimport Data.Map.Strict qualified as M\nimport Data.Text (Text, pack)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport System.Random (randomRIO)\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.JSON\n\ntype TodoId = Text\n\nnewtype AllTodos = AllTodos (Map TodoId Todo)\n  deriving (Generic)\n  deriving newtype (ToJSON, FromJSON)\n  deriving (ToEncoded, FromEncoded) via (JSON AllTodos)\n\ninstance Session AllTodos where\n  sessionKey = \"todos\"\n  cookiePath = Just \"/examples\" -- share data between both pages\ninstance Default AllTodos where\n  def = AllTodos mempty\n\ndata Todo = Todo\n  { id :: TodoId\n  , task :: Text\n  , completed :: Bool\n  }\n  deriving (Generic, ToJSON, FromJSON, ToParam, FromParam)\n\ndata Todos :: Effect where\n  LoadAll :: Todos m [Todo]\n  Save :: Todo -> Todos m ()\n  Remove :: TodoId -> Todos m ()\n  Create :: Text -> Todos m TodoId\ntype instance DispatchOf Todos = 'Dynamic\nrunTodosSession\n  :: forall es a\n   . (Hyperbole :> es, IOE :> es)\n  => Eff (Todos : es) a\n  -> Eff es a\nrunTodosSession = interpret $ \\_ -> \\case\n  LoadAll -> do\n    AllTodos todos <- session\n    pure $ M.elems todos\n  Save todo -> do\n    modifySession_ $ insert todo\n  Remove todoId -> do\n    modifySession_ $ delete todoId\n  Create task -> do\n    todoId <- randomId\n    let todo = Todo todoId task False\n    modifySession_ $ insert todo\n    pure todoId\n where\n  randomId :: (IOE :> es) => Eff es Text\n  randomId = do\n    n <- randomRIO @Int (0, 9999999)\n    pure $ \"todo-\" <> pack (show n)\n\n  insert :: Todo -> AllTodos -> AllTodos\n  insert todo (AllTodos m) =\n    AllTodos (M.insert todo.id todo m)\n\n  delete :: TodoId -> AllTodos -> AllTodos\n  delete todoId (AllTodos m) =\n    AllTodos (M.delete todoId m)\n\nloadAll :: (Todos :> es) => Eff es [Todo]\nloadAll = send LoadAll\n\ncreate :: (Todos :> es) => Text -> Eff es TodoId\ncreate t = send $ Create t\n\nsetTask :: (Todos :> es) => Text -> Todo -> Eff es Todo\nsetTask task t = do\n  let updated = t{task}\n  send $ Save updated\n  pure updated\n\nsetCompleted :: (Todos :> es) => Bool -> Todo -> Eff es Todo\nsetCompleted completed todo = do\n  let updated = todo{completed}\n  send $ Save updated\n  pure updated\n\ntoggleAll :: (Todos :> es) => [Todo] -> Eff es [Todo]\ntoggleAll todos = do\n  let shouldComplete = any (\\t -> not t.completed) todos\n  mapM (setCompleted shouldComplete) todos\n\nclearCompleted :: (Todos :> es) => Eff es [Todo]\nclearCompleted = do\n  todos <- loadAll\n  let completed = filter (.completed) todos\n  mapM_ clear completed\n  loadAll\n\nclear :: (Todos :> es) => Todo -> Eff es ()\nclear todo = do\n  send $ Remove todo.id\n\nfilteredTodos :: (Todos :> es) => FilterTodo -> Eff es [Todo]\nfilteredTodos filt =\n  filter (isFilter filt) <$> loadAll\n where\n  isFilter f todo =\n    case f of\n      FilterAll -> True\n      Active -> not todo.completed\n      Completed -> todo.completed\n\ndata FilterTodo\n  = FilterAll\n  | Active\n  | Completed\n  deriving (Eq, Generic, ToJSON, FromJSON, ToParam, FromParam)\n"
  },
  {
    "path": "demo/Example/Effects/Users.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Example.Effects.Users where\n\nimport App.Route (UserId)\nimport Control.Concurrent.MVar\nimport Data.Map.Strict (Map)\nimport Data.Map.Strict qualified as M\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Web.Hyperbole (Hyperbole, notFound)\n\ndata User = User\n  { id :: UserId\n  , firstName :: Text\n  , lastName :: Text\n  , age :: Int\n  , info :: Text\n  , isActive :: Bool\n  }\n  deriving (Show)\n\n-- Load a user AND do next if missing?\ndata Users :: Effect where\n  LoadUser :: UserId -> Users m (Maybe User)\n  LoadUsers :: Users m [User]\n  SaveUser :: User -> Users m ()\n  ModifyUser :: UserId -> (User -> User) -> Users m ()\n  DeleteUser :: UserId -> Users m ()\n  NextId :: Users m UserId\n\ntype instance DispatchOf Users = 'Dynamic\n\ntype UserStore = MVar (Map UserId User)\n\nrunUsersIO\n  :: (IOE :> es)\n  => UserStore\n  -> Eff (Users : es) a\n  -> Eff es a\nrunUsersIO var = interpret $ \\_ -> \\case\n  LoadUser uid -> do\n    us <- liftIO $ readMVar var\n    pure $ M.lookup uid us\n  LoadUsers -> loadAll\n  SaveUser u -> do\n    modify $ \\us -> pure $ M.insert u.id u us\n  ModifyUser uid f -> do\n    modify $ \\us -> do\n      pure $ M.adjust f uid us\n  DeleteUser uid -> do\n    modify $ \\us -> pure $ M.delete uid us\n  NextId -> do\n    us <- loadAll\n    let umax = maximum $ fmap (.id) us\n    pure (umax + 1)\n where\n  loadAll :: (MonadIO m) => m [User]\n  loadAll = do\n    us <- liftIO $ readMVar var\n    pure $ M.elems us\n\n  modify :: (MonadIO m) => (Map UserId User -> IO (Map UserId User)) -> m ()\n  modify f = liftIO $ modifyMVar_ var f\n\ninitUsers :: (MonadIO m) => m UserStore\ninitUsers =\n  liftIO $ newMVar $ M.fromList $ map (\\u -> (u.id, u)) users\n where\n  users =\n    [ User 1 \"Joe\" \"Blow\" 32 \"\" True\n    , User 2 \"Sara\" \"Dane\" 24 \"\" False\n    , User 3 \"Billy\" \"Bob\" 48 \"\" False\n    , User 4 \"Felicia\" \"Korvus\" 84 \"\" True\n    ]\n\nfind :: (Hyperbole :> es, Users :> es) => Int -> Eff es User\nfind uid = do\n  mu <- send (LoadUser uid)\n  maybe notFound pure mu\n\nall :: (Users :> es) => Eff es [User]\nall = send LoadUsers\n\nsave :: (Users :> es) => User -> Eff es ()\nsave = send . SaveUser\n\ndelete :: (Users :> es) => Int -> Eff es ()\ndelete = send . DeleteUser\n\nnextId :: (Users :> es) => Eff es Int\nnextId = send NextId\n"
  },
  {
    "path": "demo/Example/Errors.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Errors where\n\nimport App.Docs\nimport Effectful.Exception\nimport Example.Colors\nimport Text.Read (readMaybe)\nimport Example.Style.Cyber as Cyber (btn)\nimport Control.Monad (forM_)\nimport Data.List qualified as L\nimport Data.Text (Text, pack, unpack)\nimport Web.Atomic.CSS\nimport Web.Hyperbole hiding (Response)\n\n-- Exceptiosn\n\ndata Errors = Exceptions | Customs\n  deriving (Generic, ViewId)\n\ninstance HyperView Errors es where\n  data Action Errors\n    = CauseServerside\n    | CauseUserFacing\n    | CauseCustom\n    deriving (Generic, ViewAction)\n\n  update CauseServerside = do\n    _ <- throwIO $ SomeServerError \"Oh no!\"\n    pure $ el \"unreachable\"\n  update CauseUserFacing = do\n    _ <- respondError \"This is a user-facing custom error\"\n    pure $ el \"unreachable\"\n  update CauseCustom = do\n    _ <- respondErrorView \"Something\" $ do\n      el ~ border 1 . borderColor Danger . rounded 3 $ \"Style errors however you want!\"\n    pure $ el \"unreachable\"\n\nviewExceptions :: View Errors ()\nviewExceptions = do\n  row ~ gap 10 $ do\n    button CauseServerside ~ btn $ \"Cause Exception\"\n\nviewCustom :: View Errors ()\nviewCustom = do\n  row ~ gap 10 $ do\n    button CauseUserFacing ~ btn $ \"Custom Error Message\"\n    button CauseCustom ~ btn $ \"Custom Error View\"\n\ndata SomeServerError\n  = SomeServerError String\n  deriving (Show, Eq, Exception)\n\n-- Users ------------------------------------------------\n\ndata User = User\n  { id :: Int\n  , username :: Text\n  }\n\ntype UserId = Int\ntype UserName = Text\n\nfakeDatabase :: [User]\nfakeDatabase =\n  [ User 1 \"Bob\"\n  , User 2 \"Sarah\"\n  , User 3 \"Alice\"\n  ]\n\nfindUser :: UserId -> Eff es (Maybe User)\nfindUser uid =\n  pure $ L.find (\\(User i _) -> uid == i) fakeDatabase\n\n\n-- KnownUsers ------------------------------------------------\n\ndata Users = KnownUsers | SearchUsers\n  deriving (Generic, ViewId)\n\ninstance HyperView Users es where\n  data Action Users\n    = UserDetails Int\n    | SearchUser Text\n    deriving (Generic, ViewAction)\n\n  update (UserDetails uid) = do\n    mu <- findUser uid\n    case mu of\n      Nothing -> notFound\n      Just u -> pure $ do\n        viewWithDetails (viewUserDetails u) viewKnownUsers\n  update (SearchUser term) = do\n    mu <- searchUser term\n    pure $ do\n      viewWithDetails (viewSearchResults mu) viewSearchUsers\n\nviewKnownUsers :: View Users ()\nviewKnownUsers = do\n  col ~ gap 10 $ do\n    el \"We know all these users exist when the view was rendered, so one going missing is unlikely\"\n    row ~ gap 10 $ do\n      forM_ fakeDatabase $ \\u -> do\n        button (UserDetails u.id) ~ btn $ text $ \"User: \" <> pack (show u.id)\n\n    el \"If a user were deleted between when they were rendered and loaded, the error would look like this:\"\n    button (UserDetails 4) ~ btn $ \"Attempt to load non-existing User 4\"\n\nviewWithDetails :: View c () -> View c () -> View c ()\nviewWithDetails details cnt = do\n  col ~ gap 10 $ do\n    details\n    cnt\n\nviewUserDetails :: User -> View c ()\nviewUserDetails u = do\n  col ~ gap 10 . pad 10 . border 1 $ do\n    el $ do\n      text \"ID: \"\n      text $ pack $ show u.id\n    el $ do\n      text \"Name: \"\n      text u.username\n\n-- SearchUsers ------------------------------------------------\n\nsearchUser :: Text -> Eff es (Maybe User)\nsearchUser searchTerm =\n  pure $ findId searchTerm\n where\n  findId term = do\n    uid <- readMaybe @Int (unpack term)\n    L.find (\\(User i _) -> uid == i) fakeDatabase\n\nviewSearchUsers :: View Users ()\nviewSearchUsers = do\n  el \"Search for a user by id\"\n  search SearchUser 250 ~ border 1 . pad 10 @ placeholder \"2\"\n\nviewSearchResults :: Maybe User -> View c ()\nviewSearchResults mu = do\n  case mu of\n    Nothing -> el ~ italic $ \"User not found. No big deal. Doesn't need to be an application error\"\n    Just u -> viewUserDetails u\n\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/FormSimple.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.FormSimple where\n\nimport App.Docs\nimport Data.Text (Text, pack)\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\ndata AddContact = AddContact\n  deriving (Generic, ViewId)\n\ninstance HyperView AddContact es where\n  data Action AddContact\n    = Submit\n    deriving (Generic, ViewAction)\n\n  update Submit = do\n    cf <- formData\n    pure $ contactView cf\n\ndata Planet\n  = Mercury\n  | Venus\n  | Earth\n  | Mars\n  deriving (Generic, FromParam, ToParam, Eq, Show)\n\ndata Moon\n  = Titan\n  | Europa\n  | Callisto\n  | Mimas\n  deriving (Generic, FromParam, ToParam, Eq, Show)\n\n-- Forms can be pretty simple. Just a type that can be parsed\ndata ContactForm = ContactForm\n  { name :: Text\n  , age :: Int\n  , isFavorite :: Bool\n  , planet :: Planet\n  , moon :: Moon\n  }\n  deriving (Generic, FromForm)\n\nnameForm :: View AddContact ()\nnameForm = do\n  form Submit $ do\n    -- Make sure these names match the field names used by FormParse / formData\n    field \"name\" $ do\n      label $ do\n        text \"Contact Name\"\n        input Username @ placeholder \"contact name\"\n\n-- and a view that displays an input for each field\nformView :: View AddContact ()\nformView = do\n  form Submit ~ gap 15 . pad 10 . flexCol $ do\n    el ~ Style.h1 $ \"Add Contact\"\n\n    -- Make sure these names match the field names used by FormParse / formData\n    field \"name\" $ do\n      label $ do\n        text \"Contact Name\"\n        input Username @ placeholder \"contact name\" ~ Style.input\n\n    field \"age\" $ do\n      label $ do\n        text \"Age\"\n        input Number @ placeholder \"age\" . value \"0\" ~ Style.input\n\n    field \"isFavorite\" $ do\n      label $ do\n        row ~ gap 10 $ do\n          checkbox False ~ width 32\n          text \"Favorite?\"\n\n    col ~ gap 5 $ do\n      el $ text \"Planet\"\n      field \"planet\" $ do\n        radioGroup Earth $ do\n          planet Mercury\n          planet Venus\n          planet Earth\n          planet Mars\n\n    field \"moon\" $ do\n      label $ do\n        text \"Moon\"\n        select Callisto ~ Style.input $ do\n          option Titan \"Titan\"\n          option Europa \"Europa\"\n          option Callisto \"Callisto\"\n          option Mimas \"Mimas\"\n\n    submit \"Submit\" ~ btn\n where\n  planet val =\n    label ~ flexRow . gap 10 $ do\n      radio val ~ width 32\n      text (pack (show val))\n\n-- Alternatively, use Higher Kinded Types, and Hyperbole can guarantee the field names are the same\n--\n-- ContactForm' Identity is exactly the same as ContactForm:\n-- ContactForm' { name :: Text, age :: Int }\n--\n-- ContactForm' FieldName:\n-- ContactForm' { name :: FieldName Text, age :: FieldName Int }\n--\n-- ContactForm' Maybe:\n-- ContactForm' { name :: Maybe Text, age :: Maybe Int }\n--\n-- You still have to remember to include all the fields somewhere in the form\ndata ContactForm' f = ContactForm'\n  { name :: Field f Text\n  , age :: Field f Int\n  , isFavorite :: Field f Bool\n  , planet :: Field f Planet\n  , moon :: Field f Moon\n  }\n  deriving (Generic, FromFormF, GenFields FieldName)\n\nnameForm' :: View AddContact ()\nnameForm' = do\n  let f = fieldNames @ContactForm'\n  form Submit $ do\n    field f.name $ do\n      label $ do\n        text \"Contact Name\"\n        input Username @ placeholder \"contact name\"\n\nformView' :: View AddContact ()\nformView' = do\n  -- generate a ContactForm' FieldName\n  let f = fieldNames @ContactForm'\n  form Submit ~ gap 15 . pad 10 $ do\n    el ~ Style.h1 $ \"Add Contact\"\n\n    -- f.name :: FieldName Text\n    -- f.name = FieldName \"name\"\n    field f.name $ do\n      label $ do\n        text \"Contact Name\"\n        input Username @ placeholder \"contact name\" ~ Style.input\n\n    -- f.age :: FieldName Int\n    -- f.age = FieldName \"age\"\n    field f.age $ do\n      label $ do\n        text \"Age\"\n        input Number @ placeholder \"age\" . value \"0\" ~ Style.input\n\n    field f.isFavorite $ do\n      label $ do\n        row ~ gap 10 $ do\n          checkbox False ~ width 32\n          text \"Favorite?\"\n\n    col ~ gap 5 $ do\n      el $ text \"Planet\"\n      field f.planet $ do\n        radioGroup Earth $ do\n          radioOption Mercury\n          radioOption Venus\n          radioOption Earth\n          radioOption Mars\n\n    field f.moon $ do\n      label $ do\n        text \"Moon\"\n        select Callisto ~ Style.input $ do\n          option Titan \"Titan\"\n          option Europa \"Europa\"\n          option Callisto \"Callisto\"\n          option Mimas \"Mimas\"\n\n    submit \"Submit\" ~ btn\n where\n  radioOption val =\n    label ~ flexRow . gap 10 $ do\n      radio val ~ width 32\n      text (pack (show val))\n\ncontactView :: ContactForm -> View AddContact ()\ncontactView u = do\n  el ~ bold . Style.success $ \"Accepted Signup\"\n  row ~ gap 5 $ do\n    el \"Username:\"\n    el $ text u.name\n\n  row ~ gap 5 $ do\n    el \"Age:\"\n    el $ text $ pack (show u.age)\n\n  row ~ gap 5 $ do\n    el \"Favorite:\"\n    el $ text $ pack (show u.isFavorite)\n\n  row ~ gap 5 $ do\n    el \"Planet:\"\n    el $ text $ pack (show u.planet)\n\n  row ~ gap 5 $ do\n    el \"Moon:\"\n    el $ text $ pack (show u.moon)\n"
  },
  {
    "path": "demo/Example/FormValidation.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.FormValidation where\n\nimport Data.Text (Text, pack)\nimport Data.Text qualified as T\nimport App.Docs\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nsource :: ModuleSource\nsource = $(moduleSource)\n\ndata Signup = Signup\n  deriving (Generic, ViewId)\n\ninstance HyperView Signup es where\n  data Action Signup\n    = Submit\n    deriving (Generic, ViewAction)\n\n  update Submit = do\n    uf <- formData @(UserForm Identity)\n\n    let vals = validateForm uf\n\n    if anyInvalid vals\n      then pure $ formView vals\n      else pure $ userView uf\n\n-- Form Fields\nnewtype User = User {username :: Text}\n  deriving newtype (FromParam)\n\ndata UserForm f = UserForm\n  { user :: Field f User\n  , age :: Field f Int\n  , pass1 :: Field f Text\n  , pass2 :: Field f Text\n  }\n  deriving (Generic, FromFormF, GenFields Validated, GenFields FieldName)\n\nanyInvalid :: UserForm Validated -> Bool\nanyInvalid u =\n  or [isInvalid u.user, isInvalid u.age, isInvalid u.pass1, isInvalid u.pass2]\n\nvalidateForm :: UserForm Identity -> UserForm Validated\nvalidateForm u =\n  UserForm\n    { user = validateUser u.user\n    , age = validateAge u.age\n    , pass1 = validatePass u.pass1 u.pass2\n    , pass2 = NotInvalid\n    }\n\nvalidateAge :: Int -> Validated Int\nvalidateAge a =\n  validate (a < 20) \"User must be at least 20 years old\"\n\nvalidateUser :: User -> Validated User\nvalidateUser (User u) =\n  mconcat\n    [ validate (T.elem ' ' u) \"Username must not contain spaces\"\n    , validate (T.length u < 4) \"Username must be at least 4 chars\"\n    , if u == \"admin\" || u == \"guest\"\n        then Invalid \"Username is already in use\"\n        else Valid\n    ]\n\nvalidatePass :: Text -> Text -> Validated Text\nvalidatePass p1 p2 =\n  mconcat\n    [ validate (p1 /= p2) \"Passwords did not match\"\n    , validate (T.length p1 < 8) \"Password must be at least 8 chars\"\n    ]\n\nformView :: UserForm Validated -> View Signup ()\nformView val = do\n  let f = fieldNames @UserForm\n  form Submit ~ gap 15 . pad 10 $ do\n    el ~ Style.h1 $ \"Sign Up\"\n\n    field f.user ~ valStyle val.user $ do\n      label $ do\n        text \"Username\"\n        input Username @ placeholder \"username\" ~ Style.input\n\n        case val.user of\n          Invalid t -> el (text t)\n          Valid -> el \"Username is available\"\n          _ -> none\n\n    field f.age ~ valStyle val.age $ do\n      label $ do\n        text \"Age\"\n        input Number @ placeholder \"age\" ~ Style.input\n        el $ invalidText val.age\n\n    field f.pass1 ~ valStyle val.pass1 $ do\n      label $ do\n        text \"Password\"\n        input NewPassword @ placeholder \"password\" ~ Style.input\n        el $ invalidText val.pass1\n\n    field f.pass2 $ do\n      label $ do\n        text \"Repeat Password\"\n        input NewPassword @ placeholder \"repeat password\" ~ Style.input\n\n    submit \"Submit\" ~ btn\n where\n  valStyle (Invalid _) = Style.invalid\n  valStyle Valid = Style.success\n  valStyle _ = id\n\nuserView :: UserForm Identity -> View Signup ()\nuserView u = do\n  el ~ bold . Style.success $ \"Accepted Signup\"\n  row ~ gap 5 $ do\n    el \"Username:\"\n    el $ text u.user.username\n\n  row ~ gap 5 $ do\n    el \"Age:\"\n    el $ text $ pack (show u.age)\n\n  row ~ gap 5 $ do\n    el \"Password:\"\n    el $ text u.pass1\n"
  },
  {
    "path": "demo/Example/Interactivity/Events.hs",
    "content": "module Example.Interactivity.Events where\n\nimport Data.Text (Text, pack)\nimport Example.Colors\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole hiding (button, input)\n\n-- Try Events --------------------------------------\n\ndata TryEvents = TryEvents\n  deriving (Generic, ViewId)\n\ninstance HyperView TryEvents es where\n  data Action TryEvents\n    = SetMessage Text\n    deriving (Generic, ViewAction)\n\n  update (SetMessage t) = do\n    pure $ viewEvents t\n\nviewEvents :: Text -> View TryEvents ()\nviewEvents t = do\n  el ~ bold $ text t\n  input @ onInput SetMessage 250 ~ border 1 . pad 5 $ none\n  button @ onDblClick (SetMessage \"\") ~ btn $ \"Double Click to Clear\"\n where\n  input = tag \"input\"\n  button = tag \"button\"\n\n-- Boxes -----------------------------------\n\ndata Boxes = Boxes\n  deriving (Generic, ViewId)\n\ninstance HyperView Boxes es where\n  data Action Boxes\n    = SelectBox Int\n    | ClearBox\n    deriving (Generic, ViewAction)\n\n  -- favor the last action that happens\n  type Concurrency Boxes = Replace\n\n  update (SelectBox n) = do\n    pure $ viewBoxes (Just n)\n  update ClearBox = do\n    pure $ viewBoxes Nothing\n\nviewBoxes :: Maybe Int -> View Boxes ()\nviewBoxes mn = do\n  boxes mn $ \\n -> do\n    el ~ box @ onMouseEnter (SelectBox n) . onMouseLeave ClearBox $ text $ pack $ show n\n\nboxes :: Maybe Int -> (Int -> View c ()) -> View c ()\nboxes mn boxView = do\n  let ns = [0 .. 50] :: [Int]\n  el ~ grid . gap 10 . pad 10 $ do\n    col ~ double . border 2 . bold . fontSize 48 $ do\n      space\n      el ~ textAlign AlignCenter $ text $ pack $ maybe \"\" show mn\n      space\n    mapM_ boxView ns\n\nbox :: (Styleable h) => CSS h -> CSS h\nbox =\n  border 1\n    . pad 10\n    . pointer\n    . hover (bg PrimaryLight)\n    . textAlign AlignCenter\n\ngrid :: (Styleable h) => CSS h -> CSS h\ngrid =\n  utility\n    \"grid\"\n    [ \"display\" :. \"grid\"\n    , \"grid-template-columns\" :. \"repeat(auto-fit, minmax(50px, 1fr))\"\n    ]\n\ndouble :: (Styleable h) => CSS h -> CSS h\ndouble =\n  utility\n    \"double\"\n    [ \"grid-column\" :. \"1 / span 2\"\n    , \"grid-row\" :. \"1 / span 2\"\n    ]\n"
  },
  {
    "path": "demo/Example/Interactivity/Inputs.hs",
    "content": "module Example.Interactivity.Inputs where\n\nimport Data.Text (pack)\nimport Web.Atomic.CSS\nimport Web.Hyperbole hiding (button, input)\n\ndata Dropper = Dropper\n  deriving (Generic, ViewId)\n\ndata Planet\n  = Mercury\n  | Venus\n  | Earth\n  | Mars\n  deriving (Generic, FromParam, ToParam, Eq, Show, Enum, Bounded)\n\ninstance HyperView Dropper es where\n  data Action Dropper\n    = Select (Maybe Planet)\n    deriving (Generic, ViewAction)\n\n  update (Select mp) = do\n    pure $ selectPlanet mp\n\nselectPlanet :: Maybe Planet -> View Dropper ()\nselectPlanet mp = do\n  dropdown Select mp ~ border 1 . pad 10 $ do\n    option Nothing \"Choose a Planet\"\n    option (Just Mercury) \"Mercury\"\n    option (Just Venus) \"Venus\"\n    option (Just Earth) \"Earth\"\n    option (Just Mars) \"Mars\"\n  case mp of\n    Nothing -> none\n    Just p -> el $ text $ \"You chose: \" <> pack (show p)\n"
  },
  {
    "path": "demo/Example/Javascript.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Javascript where\n\nimport Data.Text (Text, pack)\nimport App.Docs\nimport Example.Interactivity.Events (box, boxes)\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[JBoxes, Message]\npage = do\n  pure $ do\n    script \"custom.js\"\n    hyper JBoxes $ viewJBoxes Nothing\n    hyper Message viewMessage\n\ndata JBoxes = JBoxes\n  deriving (Generic, ViewId)\n\ninstance HyperView JBoxes es where\n  data Action JBoxes\n    = Selected Int\n    | Clear\n    deriving (Generic, ViewAction)\n\n  type Concurrency JBoxes = Replace\n\n  update (Selected n) = do\n    pure $ viewJBoxes (Just n)\n  update Clear = do\n    pure $ viewJBoxes Nothing\n\nviewJBoxes :: Maybe Int -> View JBoxes ()\nviewJBoxes mn = do\n  boxes mn $ \\n -> do\n    el ~ box . cls \"box\" $ text $ pack $ show n\n\ndata Message = Message\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message = AlertMe\n    deriving (Generic, ViewAction)\n\n  update AlertMe = do\n    pushEvent \"server-message\" (\"hello\" :: Text)\n    pure \"Sent 'server-message' event\"\n\nviewMessage :: View Message ()\nviewMessage = do\n  button AlertMe ~ btn $ \"Alert Me\"\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Push.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Push where\n\nimport App.Docs\nimport Control.Monad (forM_)\nimport Effectful\nimport Example.Colors\nimport Example.Effects.Debug\nimport Example.Style.Cyber (btn)\nimport Example.View.Inputs (progressBar)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Tasks = Tasks\n  deriving (Generic, ViewId)\n\ninstance (Debug :> es) => HyperView Tasks es where\n  data Action Tasks\n    = RunLongTask\n    | Interrupt\n    deriving (Generic, ViewAction)\n\n  type Concurrency Tasks = Replace\n\n  update RunLongTask = do\n    forM_ [1 :: Float .. 100] $ \\n -> do\n      pushUpdate $ taskView (n / 100)\n      delay 50\n    pure $ taskView 1\n  update Interrupt = do\n    pure $ col ~ gap 10 $ do\n      el \"Interrupted!\"\n      taskView 0\n\ntaskView :: Float -> View Tasks ()\ntaskView pct = col ~ gap 10 $ do\n  taskBar\n\n  if isRunning\n    then button Interrupt ~ btn $ \"Interrupt\"\n    else button RunLongTask ~ btn . whenLoading disabled $ \"Run Task\"\n where\n  taskBar\n    | pct == 0 = el ~ bg Light . pad 5 $ \"Task\"\n    | pct >= 1 = row ~ bg Success . color White . pad 5 $ el $ text \"Complete\"\n    | otherwise = progressBar pct \"Task\"\n\n  isRunning = pct > 0 && pct < 1\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Requests.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Requests where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport App.Docs\nimport Example.Colors\nimport Example.Style.Cyber as Cyber (btn, btn')\nimport Web.Atomic.CSS\nimport Web.Hyperbole hiding (Response)\nimport Web.Hyperbole.Data.URI\n\n-- REQUEst -------------------------------------------------\n\ndata CheckRequest = CheckRequest\n  deriving (Generic, ViewId)\n\ninstance HyperView CheckRequest es where\n  data Action CheckRequest\n    = Refresh\n    deriving (Generic, ViewAction)\n\n  update Refresh = do\n    r <- request\n    pure $ viewRequest r\n\nviewRequest :: Request -> View CheckRequest ()\nviewRequest r = do\n  col ~ gap 10 $ do\n    el $ do\n      text \"Host: \"\n      text $ cs $ show r.host\n    el $ do\n      text \"Path: \"\n      text $ cs $ show r.path\n    el $ do\n      text \"Query: \"\n      text $ cs $ show r.query\n    el $ do\n      text \"Cookies: \"\n      text $ cs $ show r.cookies\n\n-- CLIENT -------------------------------------------------\n\ndata Message = Message\n  { message :: Text\n  }\n  deriving (Generic, ToQuery)\n\ndata ControlClient = ControlClient\n  deriving (Generic, ViewId)\n\ninstance HyperView ControlClient es where\n  type Require ControlClient = '[CheckRequest]\n\n  data Action ControlClient\n    = SetQuery\n    | ClearQuery\n    deriving (Generic, ViewAction)\n\n  update SetQuery = do\n    setQuery $ Message \"hello\"\n    trigger CheckRequest Refresh\n    pure $ do\n      el \"Updated Query String\"\n      viewClient\n  update ClearQuery = do\n    clearQuery\n    trigger CheckRequest Refresh\n    pure viewClient\n\nviewClient :: View ControlClient ()\nviewClient = do\n  button SetQuery ~ btn $ \"Set Query from another HyperView\"\n  button ClearQuery ~ btn $ \"Clear Query\"\n\n-- RESPONSE -------------------------------------------------\n\ndata ControlResponse = ControlResponse\n  deriving (Generic, ViewId)\n\ninstance HyperView ControlResponse es where\n  data Action ControlResponse\n    = RedirectAsAction\n    | SetPageTitle\n    | RespondNotFound\n    | -- \\| RespondEarlyView\n      RespondWithError\n    deriving (Generic, ViewAction)\n  update RedirectAsAction = do\n    redirect $ pathUri \"/hello/redirected\"\n  update SetPageTitle = do\n    pageTitle \"Hello World!\"\n    pure $ col ~ gap 10 $ do\n      el ~ bold $ \"Set page title!\"\n      responseView\n  update RespondNotFound = do\n    _ <- notFound\n    pure \"This will not be rendered\"\n  -- update RespondEarlyView = do\n  --   _ <- respondView ControlResponse \"Responded early!\"\n  --   pure \"This will not be rendered\"\n  update RespondWithError = do\n    _ <- respondError \"Some custom error\"\n    pure \"This will not be rendered\"\n\nresponseView :: View ControlResponse ()\nresponseView = do\n  row ~ gap 10 . flexWrap Wrap $ do\n    button RedirectAsAction ~ btn $ \"Redirect Me\"\n    button SetPageTitle ~ btn $ \"Set Page Title\"\n    button RespondNotFound ~ btn' Danger $ \"Respond Not Found\"\n    button RespondWithError ~ btn' Danger $ \"Respond Error\"\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/Scrollbars.hs",
    "content": "module Example.Scrollbars where\n\nimport Control.Monad (forM_)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Effectful\nimport Example.Colors\nimport Example.Style.Cyber (btn, btnLight)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ntest :: IO ()\ntest = do\n  putStrLn \"Starting...\"\n  run 3000 $ do\n    liveApp quickStartDocument (runPage page)\n\npage' :: (Hyperbole :> es) => Page es '[Long]\npage' = do\n  pure $ do\n    style \"body { height: 100vh; overflow: hidden; } \"\n    hyper Long (longView Nothing) ~ height (Pct 1)\n\ndata Long = Long\n  deriving (Generic, ViewId)\n\ninstance HyperView Long es where\n  data Action Long\n    = Select Text\n    deriving (Generic, ViewAction)\n\n  update (Select t) = do\n    pure $ longView (Just t)\n\nlongView :: Maybe Text -> View Long ()\nlongView sel = do\n  row ~ height (Pct 1) $ do\n    col ~ gap 10 . pad 10 . bg cyan . width 200 . height (Pct 1) . overflow Auto $ do\n      forM_ [0 .. 100 :: Int] $ \\n -> do\n        let val = cs $ \"Item \" <> show n\n        button (Select val) ~ btnLight . slide val $ text val\n\n    col ~ gap 10 . pad 20 . border 3 . grow $ do\n      el ~ bold $ \"SELECTED\"\n      case sel of\n        Nothing -> \"_\"\n        Just t -> el $ text t\n where\n  slide v =\n    if Just v == sel\n      then color White . bold . btn\n      else btnLight\n\ndata Test = Test deriving (Generic, ViewId)\n\ninstance HyperView Test es where\n  data Action Test = Noop\n    deriving (Generic, ViewAction)\n\n  update Noop = do\n    pure none\n\npage :: Page es '[Test]\npage = pure $ do\n  el ~ vh100 . overflow Hidden $ do\n    col ~ height (Pct 1) . pad 25 . gap 30 $ do\n      hyper Test ~ height (Pct 1) $ do\n        col ~ overflow Scroll . height 300 . width 300 . border 1 $ do\n          forM_ [0 .. 100 :: Int] $ \\_ -> do\n            el \"HELLO\"\n where\n  vh100 = utility \"vh100\" [\"height\" :. \"100vh\"]\n"
  },
  {
    "path": "demo/Example/Simple.hs",
    "content": "{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE DeriveAnyClass #-}\n{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE TypeFamilies #-}\n\nmodule Example.Simple where\n\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nmain :: IO ()\nmain = do\n  run 3000 $ do\n    liveApp quickStartDocument (runPage page)\n\npage :: (Hyperbole :> es) => Page es '[Message]\npage = do\n  pure $ do\n    hyper Message1 $ messageView \"Hello\"\n    hyper Message2 $ messageView \"World!\"\n\ndata Message = Message1 | Message2\n  deriving (Generic, ViewId)\n\ninstance HyperView Message es where\n  data Action Message\n    = Louder Text\n    deriving (Generic, ViewAction)\n\n  update (Louder msg) = do\n    let new = msg <> \"!\"\n    pure $ messageView new\n\nmessageView :: Text -> View Message ()\nmessageView msg = do\n  button (Louder msg) ~ border 1 $ text msg\n"
  },
  {
    "path": "demo/Example/State/Effects.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.State.Effects where\n\nimport App.Docs\nimport Data.Text (pack)\nimport Effectful\nimport Effectful.Concurrent.STM\nimport Effectful.Reader.Dynamic\nimport Example.Style.Cyber as Cyber (btn, dataFeature)\nimport Web.Atomic.CSS\nimport Web.Hyperbole as Hyperbole\nimport Web.Hyperbole.Data.Encoded\n\npage :: (Hyperbole :> es, Concurrent :> es, Reader (TVar Int) :> es) => Page es '[Counter]\npage = do\n  n <- getCount\n  pure $ do\n    hyper Counter (viewCount n)\n\ndata Counter = Counter\n  deriving (Generic)\ninstance ViewId Counter where\n  -- to avoid conflicts with other \"Counter\" ViewIds on example pages\n  toViewId _ = Encoded \"counter-effects\" []\n\n  parseViewId (Encoded \"counter-effects\" _) = pure Counter\n  parseViewId _ = Left \"expected constructor name\"\n\ninstance (Reader (TVar Int) :> es, Concurrent :> es) => HyperView Counter es where\n  data Action Counter\n    = Increment\n    | Decrement\n    deriving (Generic, ViewAction)\n\n  update Increment = do\n    n <- modifyCount (+ 1)\n    pure $ viewCount n\n  update Decrement = do\n    n <- modifyCount (subtract 1)\n    pure $ viewCount n\n\nviewCount :: Int -> View Counter ()\nviewCount n = row $ do\n  col ~ gap 10 $ do\n    el ~ dataFeature $ text $ pack $ show n\n    row ~ gap 10 $ do\n      button Decrement \"Decrement\" ~ btn\n      button Increment \"Increment\" ~ btn\n\nmodifyCount :: (Concurrent :> es, Reader (TVar Int) :> es) => (Int -> Int) -> Eff es Int\nmodifyCount f = do\n  var <- ask\n  atomically $ do\n    modifyTVar var f\n    readTVar var\n\ngetCount :: (Concurrent :> es, Reader (TVar Int) :> es) => Eff es Int\ngetCount = readTVarIO =<< ask\n\ninitCounter :: (Concurrent :> es) => Eff es (TVar Int)\ninitCounter = newTVarIO 0\n\napp :: TVar Int -> Application\napp var = do\n  liveApp quickStartDocument (runReader var . runConcurrent $ runPage page)\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/State/Query.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.State.Query where\n\nimport Data.Text (Text)\nimport Effectful\nimport Example.Colors\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn', btnLight)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Preferences = Preferences\n  { message :: Text\n  , color :: AppColor\n  }\n  deriving (Generic, Show, ToQuery, FromQuery)\ninstance Default Preferences where\n  def = Preferences mempty def\n\npage :: (Hyperbole :> es) => Page es '[QueryPrefs]\npage = do\n  prefs <- query @Preferences\n  pure $ do\n    hyper QueryPrefs $ viewPreferences prefs\n\ndata QueryPrefs = QueryPrefs\n  deriving (Generic, ViewId)\n\ninstance HyperView QueryPrefs es where\n  data Action QueryPrefs\n    = SaveColor AppColor\n    | SaveMessage Text\n    | Clear\n    deriving (Generic, ViewAction)\n  update (SaveColor clr) = do\n    prefs <- saveColor clr\n    pure $ viewPreferences prefs\n  update (SaveMessage msg) = do\n    prefs <- modifyQuery $ \\p -> p{message = msg}\n    pure $ viewPreferences prefs\n  update Clear = do\n    setQuery @Preferences def\n    pure $ viewPreferences def\n\nsaveColor :: (Hyperbole :> es) => AppColor -> Eff es Preferences\nsaveColor clr =\n  modifyQuery $ \\p -> p{color = clr}\n\nviewPreferences :: Preferences -> View QueryPrefs ()\nviewPreferences prefs = do\n  col ~ gap 20 $ do\n    viewColorPicker prefs.color\n    viewMessage prefs.message\n    button Clear ~ Style.btnLight $ \"Clear\"\n\nviewColorPicker :: AppColor -> View QueryPrefs ()\nviewColorPicker clr = do\n  col ~ gap 10 . pad 20 . bg clr . border 1 $ do\n    el ~ fontSize 18 . bold $ \"Query Background\"\n    row ~ gap 10 $ do\n      button (SaveColor Success) ~ (btn' Success . brd) $ \"Successs\"\n      button (SaveColor Warning) ~ (btn' Warning . brd) $ \"Warning\"\n      button (SaveColor Danger) ~ (btn' Danger . brd) $ \"Danger\"\n where\n  brd = border $ TRBL 1 0 0 1\n\nviewMessage :: Text -> View QueryPrefs ()\nviewMessage msg = do\n  col ~ gap 10 . pad 20 . border 1 $ do\n    el ~ fontSize 18 . bold $ \"Query Message\"\n    el $ text msg\n    row ~ gap 10 $ do\n      button (SaveMessage \"Hello\") ~ btnLight $ \"Msg: Hello\"\n      button (SaveMessage \"Goodbye\") ~ btnLight $ \"Msg: Goodbye\"\n"
  },
  {
    "path": "demo/Example/State/Sessions.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.State.Sessions where\n\nimport App.Docs\nimport App.Route as Route\nimport Data.Text (Text)\nimport Effectful\nimport Example.Colors\nimport Example.Style qualified as Style\nimport Example.Style.Cyber (btn', btnLight)\nimport Example.View.Layout (layout)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Preferences = Preferences\n  { message :: Text\n  , color :: AppColor\n  }\n  deriving (Generic, Show, ToEncoded, FromEncoded, Session)\ninstance Default Preferences where\n  def = Preferences \"_\" White\n\npage :: (Hyperbole :> es) => Page es '[Contents]\npage = do\n  prefs <- session @Preferences\n  pure $ layout State $ do\n    example $(moduleSource) $ do\n      el \"We can also persist state in a browser cookie. This is most useful for user-specific preferences and state that should last until they clear their browser cookies\"\n      col ~ embed $ hyper Contents $ viewContent prefs\n\ndata Contents = Contents\n  deriving (Generic, ViewId)\n\ninstance HyperView Contents es where\n  data Action Contents\n    = SaveColor AppColor\n    | SaveMessage Text\n    | ClearSession\n    deriving (Generic, ViewAction)\n  update (SaveColor clr) = do\n    prefs <- modifySession $ \\p -> p{color = clr}\n    pure $ viewContent prefs\n  update (SaveMessage msg) = do\n    prefs <- modifySession $ \\p -> p{message = msg}\n    pure $ viewContent prefs\n  update ClearSession = do\n    deleteSession @Preferences\n    pure $ viewContent def\n\nviewContent :: Preferences -> View Contents ()\nviewContent prefs = do\n  col ~ gap 20 $ do\n    viewColorPicker prefs.color\n    viewMessage prefs.message\n    button ClearSession ~ Style.btnLight $ \"Clear\"\n\nviewColorPicker :: AppColor -> View Contents ()\nviewColorPicker clr = do\n  col ~ gap 10 . pad 20 . bg clr . border 1 $ do\n    el ~ fontSize 18 . bold $ \"Session Background\"\n    row ~ gap 10 $ do\n      button (SaveColor Success) ~ (btn' Success . brd) $ \"Successs\"\n      button (SaveColor Warning) ~ (btn' Warning . brd) $ \"Warning\"\n      button (SaveColor Danger) ~ (btn' Danger . brd) $ \"Danger\"\n where\n  brd = border $ TRBL 1 0 0 1\n\nviewMessage :: Text -> View Contents ()\nviewMessage msg = do\n  col ~ gap 10 . pad 20 . border 1 $ do\n    el ~ fontSize 18 . bold $ \"Session Message\"\n    el $ text msg\n    row ~ gap 10 $ do\n      button (SaveMessage \"Hello\") ~ btnLight $ \"Msg: Hello\"\n      button (SaveMessage \"Goodbye\") ~ btnLight $ \"Msg: Goodbye\"\n"
  },
  {
    "path": "demo/Example/State/Stateless.hs",
    "content": "module Example.State.Stateless where\n\nimport Example.Style.Cyber (btn)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Swapper = Swapper\n  deriving (Generic, ViewId)\n\ninstance HyperView Swapper es where\n  data Action Swapper = Hello | Goodbye\n    deriving (Generic, ViewAction)\n\n  update Hello = pure \"Hello\"\n  update Goodbye = pure \"Goodbye\"\n\nviewSwap :: View Swapper ()\nviewSwap = do\n  button Hello ~ btn $ \"Hello\"\n  button Goodbye ~ btn $ \"Goodbye\"\n\npage :: (Hyperbole :> es) => Page es '[Swapper]\npage = do\n  pure $ do\n    hyper Swapper $ do\n      button Hello \"Hello\"\n      button Goodbye \"Goodbye\"\n"
  },
  {
    "path": "demo/Example/State/ViewState.hs",
    "content": "module Example.State.ViewState where\n\nimport Data.Text (pack)\nimport Example.Style.Cyber (btn, dataFeature)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Web.Hyperbole.HyperView\n\npage :: (Hyperbole :> es) => Page es '[Counter]\npage = do\n  pure $ do\n    hyperState CounterState 1 viewCount\n\ndata Counter = CounterState\n  deriving (Generic)\ninstance ViewId Counter where\n  type ViewState Counter = Int\n\ninstance HyperView Counter es where\n  data Action Counter\n    = Increment\n    | Decrement\n    deriving (Generic, ViewAction)\n\n  update Increment = do\n    modify @Int (+ 1)\n    pure viewCount\n  update Decrement = do\n    modify @Int (subtract 1)\n    pure viewCount\n\nviewCount :: View Counter ()\nviewCount = row $ do\n  n <- viewState\n  col ~ gap 10 $ do\n    el ~ dataFeature $ text $ pack $ show n\n    row ~ gap 10 $ do\n      button Decrement \"Decrement\" ~ btn\n      button Increment \"Increment\" ~ btn\n"
  },
  {
    "path": "demo/Example/Style/Cyber.hs",
    "content": "module Example.Style.Cyber where\n\nimport Data.Text (Text, pack)\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Atomic.Types (style, (-.))\nimport Web.Hyperbole hiding (style)\nimport Web.Hyperbole.Types.Response\n\nclip :: (Styleable h) => PxRem -> CSS h -> CSS h\nclip size =\n  utility\n    (\"clip-br\" -. size)\n    [\"clip-path\" :. (\"polygon(0 0, 100% 0, 100% calc(100% - \" <> style size <> \"), calc(100% - \" <> style size <> \") 100%, 0 100%);\")]\n\ntextShadow :: (Styleable h) => CSS h -> CSS h\ntextShadow =\n  utility\n    \"text-shadow\"\n    [\"text-shadow\" :. \"0 0 4px #0ff, 0 0 8px #0ff\"]\n\ndataFeature :: (Styleable h) => CSS h -> CSS h\ndataFeature =\n  bold . fontSize 48 . border 1 . pad (XY 20 0) . font . textAlign AlignCenter\n\nbtn :: (Styleable h) => CSS h -> CSS h\nbtn = btn' Primary\n\nbtn' :: (Styleable h) => AppColor -> CSS h -> CSS h\nbtn' clr =\n  bgAnimated\n    . bgGradient clr\n    . hover bgzero\n    . font\n    . color (contrastColor clr)\n    . pad 10\n    . clip 10\n    . shadow ()\n\nbtnLight :: (Styleable h) => CSS h -> CSS h\nbtnLight =\n  base\n    . border 2\n    . borderColor Secondary\n    . font\n    . color Secondary\n    . hover (borderColor SecondaryLight . color SecondaryLight)\n where\n  base = pad (XY 15 8)\n\nbgAnimated :: (Styleable h) => CSS h -> CSS h\nbgAnimated =\n  utility\n    \"bg-anim\"\n    [ \"background-size\" :. \"200% 100%\"\n    , \"background-position\" :. \"100% 0\"\n    , \"transition\" :. \"background-position 0.1s linear\"\n    ]\n\nbgzero :: (Styleable h) => CSS h -> CSS h\nbgzero =\n  utility \"bg0\" [\"background-position\" :. \"0 0\"]\n\nbgGradient :: (Styleable h) => AppColor -> CSS h -> CSS h\nbgGradient clr =\n  utility\n    (\"bg-grad\" -. pack (show clr))\n    [\"background-image\" :. (\"linear-gradient(90deg, \" <> style (colorValue (hoverColor clr)) <> \" 0 50%, \" <> style (colorValue clr) <> \" 50% 100%)\")]\n\nfont :: (Styleable h) => CSS h -> CSS h\nfont = utility \"share-tech\" [\"font-family\" :. \"'Share Tech Mono'\"]\n\ncyberError :: View () () -> Body\ncyberError inner = renderBody $\n  el ~ wipeIn . border (T 4) . borderColor lightRed $ do\n    el ~ bg midRed . clip 10 . pad 10 . color White $\n      inner\n where\n  -- requires @keyframes wipeIn\n  wipeIn :: (Styleable h) => CSS h -> CSS h\n  wipeIn = utility \"wipe-in\" [\"animation\" :. \"wipeIn 0.5s steps(20, end) forwards\"]\n\nglitch :: Text -> View c ()\nglitch msg =\n  el ~ cls \"glitch\" @ att \"data-text\" msg $ text msg\n\nhighlight :: (Styleable h) => CSS h -> CSS h\nhighlight =\n  pad 15\n    . gap 10\n    . bg White\n    . flexCol\n    . clip 10\n    . font\n\nembed :: (Styleable h) => CSS h -> CSS h\nembed =\n  border (TL 0 8)\n    . borderColor (light PrimaryLight)\n    . highlight\n\nquote :: (Styleable h) => CSS h -> CSS h\nquote = highlight . italic . textAlign AlignRight\n"
  },
  {
    "path": "demo/Example/Style.hs",
    "content": "module Example.Style where\n\nimport Example.Colors\nimport Web.Atomic.CSS\n\n-- btn :: (Styleable h) => CSS h -> CSS h\n-- btn = btn' Primary\n--\n-- btn' :: (Styleable h) => AppColor -> CSS h -> CSS h\n-- btn' clr =\n--   bg clr\n--     . hover (bg (hovClr clr))\n--     . color (txtClr clr)\n--     . pad 10\n--     . shadow ()\n--     . rounded 3\n--  where\n--   hovClr Primary = PrimaryLight\n--   hovClr c = c\n--   txtClr _ = White\n\nbtnLight :: (Styleable h) => CSS h -> CSS h\nbtnLight =\n  base\n    . border 2\n    . borderColor Secondary\n    . color Secondary\n    . hover (borderColor SecondaryLight . color SecondaryLight)\n where\n  base = pad (XY 15 8)\n\nh1 :: (Styleable h) => CSS h -> CSS h\nh1 = bold . fontSize 32\n\ninvalid :: (Styleable h) => CSS h -> CSS h\ninvalid = color Danger\n\nsuccess :: (Styleable h) => CSS h -> CSS h\nsuccess = color Success\n\nlink :: (Styleable h) => CSS h -> CSS h\nlink = color Primary . underline\n\ninput :: (Styleable h) => CSS h -> CSS h\ninput = border 1 . pad 8\n\nstrikethrough :: (Styleable h) => CSS h -> CSS h\nstrikethrough =\n  utility \"strike\" [\"text-decoration\" :. \"line-through\"]\n\nuppercase :: (Styleable h) => CSS h -> CSS h\nuppercase = utility \"upper\" [\"text-transform\" :. \"uppercase\"]\n"
  },
  {
    "path": "demo/Example/Tags.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Tags where\n\nimport App.Docs\nimport App.Route qualified as Route\nimport Data.Text (Text)\nimport Example.Style.Cyber (btn)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\npage :: (Hyperbole :> es) => Page es '[Tags]\npage = do\n  pure $ layout (Route.Examples Route.Tags) $ do\n    example $(moduleSource) $ do\n      hyper Tags $ tagsView []\n\nnewtype Tag = Tag Text\n  deriving newtype (ToParam, FromParam, Eq)\n\ndata TagForm = TagForm\n  { tag :: Text\n  }\n  deriving (Generic, FromForm)\n\ndata Tags = Tags\n  deriving (Generic, ViewId)\n\ninstance HyperView Tags es where\n  data Action Tags\n    = SubmitTag [Tag]\n    | RemoveTag [Tag] Tag\n    deriving (Generic, ViewAction)\n\n  update (SubmitTag ts) = do\n    TagForm t <- formData\n    pure $ tagsView (Tag t : ts)\n  update (RemoveTag ts t) = do\n    pure $ tagsView $ filter (/= t) ts\n\ntagsView :: [Tag] -> View Tags ()\ntagsView ts = do\n  row ~ gap 5 $ do\n    mapM_ (tagView ts) ts\n\n  form (SubmitTag ts) ~ gap 10 . pad 10 . flexRow $ do\n    field \"tag\" ~ grow $ do\n      label $ do\n        input TextInput @ placeholder \"New Tag\" ~ border 1 . pad 10 @ value \"\"\n    submit \"+ Add\" ~ btn\n\ntagView :: [Tag] -> Tag -> View Tags ()\ntagView ts (Tag t) = do\n  row ~ border 1 . pad 5 . gap 5 $ do\n    button (RemoveTag ts (Tag t)) ~ pad 2 . btn $ \"X\"\n    text t\n"
  },
  {
    "path": "demo/Example/Test.hs",
    "content": "module Example.Test where\n\nimport Control.Monad (forM_)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Effectful\nimport Example.Colors\nimport Example.Style.Cyber (btn, btnLight)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ntest :: IO ()\ntest = do\n  putStrLn \"Starting...\"\n  run 3000 $ do\n    liveApp quickStartDocument (runPage page)\n\n-- TEST: add a test for Page+trigger\npage :: (Hyperbole :> es, IOE :> es) => Page es '[Long]\npage = do\n  pure $ do\n    style \"body { height: 100vh; overflow: hidden; } \"\n    hyper Long (longView Nothing) ~ height (Pct 1)\n\ndata Long = Long\n  deriving (Generic, ViewId)\n\ninstance HyperView Long es where\n  data Action Long\n    = Select Text\n    deriving (Generic, ViewAction)\n\n  update (Select t) = do\n    pure $ longView (Just t)\n\nlongView :: Maybe Text -> View Long ()\nlongView sel = do\n  row ~ height (Pct 1) $ do\n    col ~ gap 10 . pad 10 . bg cyan . width 200 . height (Pct 1) . overflow Auto $ do\n      forM_ [0 .. 100 :: Int] $ \\n -> do\n        let val = cs $ \"Item \" <> show n\n        button (Select val) ~ btnLight . slide val $ text val\n\n    col ~ gap 10 . pad 20 . border 3 . grow $ do\n      el ~ bold $ \"SELECTED\"\n      case sel of\n        Nothing -> \"_\"\n        Just t -> el $ text t\n where\n  slide v =\n    if Just v == sel\n      then color White . bold . btn\n      else btnLight\n"
  },
  {
    "path": "demo/Example/Todos/Todo.hs",
    "content": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE TemplateHaskell #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Todos.Todo where\n\nimport App.Docs\nimport App.Route qualified as Route\nimport Control.Monad (forM_)\nimport Data.Text (Text, pack)\nimport Effectful\nimport Example.Colors\nimport Example.Effects.Todos (FilterTodo (..), Todo (..), TodoId, Todos, runTodosSession)\nimport Example.Effects.Todos qualified as Todos\nimport Example.Style qualified as Style\nimport Example.View.Icon qualified as Icon\nimport Example.View.Inputs (toggleCheckbox)\nimport Example.View.Layout\nimport Web.Atomic.CSS\nimport Web.Hyperbole as Hyperbole\n\npage :: (Todos :> es) => Page es '[AllTodos, TodoView]\npage = do\n  todos <- Todos.loadAll\n  pure $ layout (Route.Examples Route.Todos) $ do\n    section' \"Todos\" $ do\n      example $(moduleSource) $ do\n        hyper AllTodos $ todosView FilterAll todos\n\n-- Keep this, it's used for documentation (+ usable via the REPL, see main below)\nsimplePage :: (Todos :> es) => Page es '[AllTodos, TodoView]\nsimplePage = do\n  todos <- Todos.loadAll\n  pure $ do\n    hyper AllTodos $ todosView FilterAll todos\n\n--- AllTodos ----------------------------------------------------------------------------\n\ndata AllTodos = AllTodos\n  deriving (Generic, ViewId)\n\ninstance (Todos :> es) => HyperView AllTodos es where\n  type Require AllTodos = '[TodoView]\n\n  data Action AllTodos\n    = ClearCompleted\n    | Filter FilterTodo\n    | SubmitTodo\n    | ToggleAll FilterTodo\n    | SetCompleted FilterTodo Todo Bool\n    | Destroy FilterTodo Todo\n    deriving (Generic, ViewAction)\n\n  update action = do\n    case action of\n      ClearCompleted -> do\n        todosView FilterAll <$> Todos.clearCompleted\n      SubmitTodo -> do\n        TodoForm task <- formData @(TodoForm Identity)\n        _ <- Todos.create task\n        ts <- Todos.loadAll\n        pure $ todosView FilterAll ts\n      Filter filt -> do\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n      ToggleAll filt -> do\n        todos <- Todos.filteredTodos filt >>= Todos.toggleAll\n        pure $ todosView filt todos\n      SetCompleted filt todo completed -> do\n        _ <- Todos.setCompleted completed todo\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n      Destroy filt todo -> do\n        Todos.clear todo\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n\ntodosView :: FilterTodo -> [Todo] -> View AllTodos ()\ntodosView filt todos = do\n  todoForm filt\n  col $ do\n    forM_ todos $ \\todo -> do\n      hyper (TodoView todo.id) $ todoView filt todo\n  statusBar filt todos\n\nstatusBar :: FilterTodo -> [Todo] -> View AllTodos ()\nstatusBar filt todos = do\n  row ~ pad 10 . color SecondaryLight $ do\n    let numLeft = length $ filter (\\t -> not t.completed) todos\n\n    el $\n      text $\n        mconcat\n          [ pack $ show numLeft\n          , \" \"\n          , pluralize numLeft \"item\" \"items\"\n          , \" \"\n          , \"left!\"\n          ]\n    space\n    row ~ gap 10 $ do\n      filterButton FilterAll \"All\"\n      filterButton Active \"Active\"\n      filterButton Completed \"Completed\"\n    space\n    button ClearCompleted ~ hover (color Primary) $ \"Clear completed\"\n where\n  filterButton f =\n    button (Filter f) ~ selectedFilter f . pad (XY 4 0) . rounded 2\n  selectedFilter f =\n    if f == filt then border 1 else id\n\n-- TodoForm ----------------------------------------------------------------------------\n\ndata TodoForm f = TodoForm\n  { task :: Field f Text\n  }\n  deriving (Generic, FromFormF, GenFields FieldName)\n\ntodoForm :: FilterTodo -> View AllTodos ()\ntodoForm filt = do\n  let f :: TodoForm FieldName = fieldNames\n  row ~ border 1 $ do\n    el ~ pad 8 $ do\n      button (ToggleAll filt) Icon.chevronDown ~ width 32 . hover (color Primary)\n    form SubmitTodo ~ grow $ do\n      field f.task $ do\n        input TextInput ~ pad 12 @ placeholder \"What needs to be done?\" . value \"\"\n\n--- TodoView ----------------------------------------------------------------------------\n\ndata TodoView = TodoView TodoId\n  deriving (Generic, ViewId)\n\ninstance (Todos :> es) => HyperView TodoView es where\n  type Require TodoView = '[AllTodos]\n\n  data Action TodoView\n    = Edit FilterTodo Todo\n    | SubmitEdit FilterTodo Todo\n    deriving (Generic, ToJSON, FromJSON, ViewAction)\n\n  update (Edit filt todo) = do\n    pure $ todoEditView filt todo\n  update (SubmitEdit filt todo) = do\n    TodoForm task <- formData @(TodoForm Identity)\n    t <- Todos.setTask task todo\n    pure $ todoView filt t\n\ntodoView :: FilterTodo -> Todo -> View TodoView ()\ntodoView filt todo = do\n  row ~ border (TRBL 0 0 1 0) . pad 10 . showDestroyOnHover $ do\n    target AllTodos () $ do\n      toggleCheckbox (SetCompleted filt todo) todo.completed\n    el (text todo.task) @ onDblClick (Edit filt todo) ~ completed . pad (XY 18 4) . grow\n    target AllTodos () $ do\n      button (Destroy filt todo) \"✕\" ~ cls \"destroy-btn\" . opacity 0 . hover (color Primary) . pad 4\n where\n  completed = if todo.completed then Style.strikethrough else id\n  showDestroyOnHover =\n    css\n      \"todo-row\"\n      \".todo-row:hover > .destroy-btn\"\n      (declarations (opacity 100))\n\ntodoEditView :: FilterTodo -> Todo -> View TodoView ()\ntodoEditView filt todo = do\n  let f = fieldNames @TodoForm\n  row ~ border (TRBL 0 0 1 0) . pad 10 $ do\n    form (SubmitEdit filt todo) ~ pad (TRBL 0 0 0 46) $ do\n      field f.task $ do\n        input TextInput @ value todo.task . autofocus ~ pad 4\n\npluralize :: Int -> Text -> Text -> Text\npluralize n singular plural =\n  if n == 1\n    then\n      singular\n    else\n      plural\n\n{-\nYou may try this in the REPL for simple tests:\n\nbash> cabal repl exe:examples lib:hyperbole\nghci> Todo.main\n-}\nmain :: IO ()\nmain = do\n  run 3000 $ do\n    liveApp quickStartDocument (runTodosSession $ runPage simplePage)\n"
  },
  {
    "path": "demo/Example/Todos/TodoCSS.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Example.Todos.TodoCSS (page) where\n\nimport App.Route hiding (Filter)\nimport Control.Monad (forM_)\nimport Data.Bool (bool)\nimport Data.Text qualified as T\nimport Example.Effects.Todos (FilterTodo (..), Todo, TodoId, Todos)\nimport Example.Effects.Todos qualified as Todos\nimport Example.Todos.Todo (Action (..), AllTodos (..), TodoForm (..), TodoView (..), pluralize)\nimport Web.Hyperbole as Hyperbole\n\n{-\n\nTo make the CSS version work and overcome the default CSS reset, we tweaked the output slightly via a few style tags here and there:\n\nonly need to add one manual rule to the footer, to override the CSS reset\n\n- main title\n  - override its absolute positioning\n- read-only item:\n  - restore border-bottom (a visual separator)\n- first footer\n  - add bottom padding\n- second footer\n  - restore default user-agent p tags margin\n\n-}\n\npage :: (Todos :> es) => Page es '[CSSTodos, CSSTodo]\npage = do\n  todos <- Todos.loadAll\n  pure $ do\n    div' $ do\n      -- Alternative stylesheet at: https://todomvc.com/examples/javascript-es6/dist/app.css\n      -- Reference implementation at: https://todomvc.com/examples/javascript-es6/dist/\n      stylesheet \"https://cdn.jsdelivr.net/npm/todomvc-app-css@2.4.3/index.min.css\"\n\n      -- Tweaks required to the stylesheet, mostly to undo the global reset we used for the\n      -- rest of the examples, but also to accomodate a slightly different DOM\n      stylesheet \"/todomvc.css\"\n\n      section @ class_ \"todoapp\" $ do\n        hyper CSSTodos $ todosView FilterAll todos\n\n      footer @ class_ \"info\" $ do\n        p \"Double-click to edit a todo\"\n        p $ do\n          span' \"Go back to the \"\n          route (Examples OtherExamples) \"examples\"\n\n--- TodosView ----------------------------------------------------------------------------\n\ndata CSSTodos = CSSTodos\n  deriving (Generic, ViewId)\n\ninstance (Todos :> es) => HyperView CSSTodos es where\n  type Require CSSTodos = '[CSSTodo]\n\n  -- reuse as the actions from the main TodoMVC example. This isn't a good\n  -- example of how to factor well, it's optimized to make the main example\n  -- readable. Focus on the views\n  newtype Action CSSTodos = MkTodosAction (Action AllTodos)\n    deriving newtype (ViewAction)\n\n  -- Repeated logic from the main Todos example. Do not follow this as an example\n  -- of how to reuse views\n  update (MkTodosAction action) = do\n    case action of\n      ClearCompleted -> do\n        todosView FilterAll <$> Todos.clearCompleted\n      SubmitTodo -> do\n        TodoForm task <- formData @(TodoForm Identity)\n        _ <- Todos.create task\n        todos <- Todos.filteredTodos FilterAll\n        pure $ todosView FilterAll todos\n      Filter filt -> do\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n      ToggleAll filt -> do\n        todos <- Todos.filteredTodos filt >>= Todos.toggleAll\n        pure $ todosView filt todos\n      SetCompleted filt todo completed -> do\n        _ <- Todos.setCompleted completed todo\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n      Destroy filt todo -> do\n        Todos.clear todo\n        todos <- Todos.filteredTodos filt\n        pure $ todosView filt todos\n\ntodosView :: FilterTodo -> [Todo] -> View CSSTodos ()\ntodosView filt todos = do\n  header @ class_ \"header\" $ do\n    h1 $ text \"todos\"\n    todoForm\n  main' @ class_ \"main\" $ do\n    div' @ class_ \"toggle-all-container\" $ do\n      input'\n        @ class_ \"toggle-all\"\n        . att \"id\" \"toggle-all\"\n        . att \"type\" \"checkbox\"\n\n      label'\n        @ class_ \"toggle-all-label\"\n        . att \"for\" \"toggle-all\"\n        . onClick (MkTodosAction $ ToggleAll filt)\n        $ text \"Mark all as complete\"\n\n      ul' @ class_ \"todo-list\" $ do\n        forM_ todos $ \\todo -> do\n          hyper (CSSTodo todo.id) $ todoView filt todo\n\n    statusBar filt todos\n\ntodoForm :: View CSSTodos ()\ntodoForm = do\n  let f :: TodoForm FieldName = fieldNames\n  form (MkTodosAction SubmitTodo) $ do\n    field f.task $ do\n      input TextInput -- we use a custom input field, because the Hyperbole one overrides autocomplete\n        @ class_ \"new-todo\"\n        {-\n          -- . autofocus\n          FIXME: turning off autofocus, that \"steals\" the focus on item click.\n          FIXME: to solve this, we could either store the \"initially focused\" state and track that boolean, or use buttons\n          FIXME: but since this example is meant to match as close as possible to the original CSS version\n          FIXME: and not diverge too much from the other todo example, I'm leaving as-is.\n         -}\n        . placeholder \"What needs to be done?\"\n\nstatusBar :: FilterTodo -> [Todo] -> View CSSTodos ()\nstatusBar filt todos = do\n  footer @ class_ \"footer\" $ do\n    let numLeft = length $ filter (\\t -> not t.completed) todos\n    span' @ class_ \"todo-count\" $ do\n      text $\n        mconcat\n          [ T.pack $ show numLeft\n          , \" \"\n          , pluralize numLeft \"item\" \"items\"\n          , \" \"\n          , \"left!\"\n          ]\n    space\n    ul' @ class_ \"filters\" $ do\n      filterLi FilterAll \"All\"\n      filterLi Active \"Active\"\n      filterLi Completed \"Completed\"\n    space\n    button (MkTodosAction ClearCompleted) @ class_ \"clear-completed\" $ \"Clear completed\"\n where\n  filterLi f str =\n    li' @ class_ \"filter\" . selectedFilter f $ do\n      a\n        @ onClick (MkTodosAction $ Filter f)\n        . att \"href\" \"\" -- harmless empty href is for the CSS\n        $ text str\n  selectedFilter f =\n    if f == filt then class_ \"selected\" else id\n\n--- TodoView ----------------------------------------------------------------------------\n\ndata CSSTodo = CSSTodo TodoId\n  deriving (Generic, ViewId)\n\ninstance (Todos :> es) => HyperView CSSTodo es where\n  type Require CSSTodo = '[CSSTodos]\n\n  newtype Action CSSTodo\n    = MkTodoAction (Action TodoView)\n    deriving newtype (ViewAction)\n\n  update (MkTodoAction action) =\n    case action of\n      Edit filt todo -> do\n        pure $ todoEditView filt todo\n      SubmitEdit filt todo -> do\n        TodoForm task <- formData @(TodoForm Identity)\n        t <- Todos.setTask task todo\n        pure $ todoView filt t\n\ntodoView :: FilterTodo -> Todo -> View CSSTodo ()\ntodoView filt todo = do\n  li'\n    @ bool id (class_ \"completed\") todo.completed\n    $ do\n      div' @ class_ \"view\" $ do\n        target CSSTodos () $ do\n          input'\n            @ class_ \"toggle\"\n            . att \"type\" \"checkbox\"\n            . onClick (MkTodosAction $ SetCompleted filt todo $ not todo.completed)\n            . checked todo.completed\n\n        label' @ class_ \"label\" . onDblClick (MkTodoAction $ Edit filt todo) $ do\n          text todo.task\n\n        target CSSTodos () $ do\n          button (MkTodosAction $ Destroy filt todo) @ class_ \"destroy\" $ \"\"\n\ntodoEditView :: FilterTodo -> Todo -> View CSSTodo ()\ntodoEditView filt todo = do\n  li' @ class_ \"editing\" $ do\n    form (MkTodoAction $ SubmitEdit filt todo) $ do\n      field \"task\" $ do\n        input TextInput\n          @ class_ \"edit\"\n          . value todo.task\n          . autofocus\n\n--- Semantic HTML Helpers ----------------------------------------------------------------------------\n--\n-- you can use semantic HTML with atomic-css too! But it is required here for the stylesheet to work\n\ndiv' :: View c () -> View c ()\ndiv' = tag \"div\"\n\nspan' :: View c () -> View c ()\nspan' = tag \"span\"\n\nsection :: View c () -> View c ()\nsection = tag \"section\"\n\nheader :: View c () -> View c ()\nheader = tag \"header\"\n\nmain' :: View c () -> View c ()\nmain' = tag \"main\"\n\nh1 :: View c () -> View c ()\nh1 = tag \"h1\"\n\np :: View c () -> View c ()\np = tag \"p\"\n\nlabel' :: View c () -> View c ()\nlabel' = tag \"label\"\n\ninput' :: View c ()\ninput' = tag \"input\" none\n\na :: View c () -> View c ()\na = tag \"a\"\n\nul' :: View c () -> View c ()\nul' = tag \"ul\"\n\nli' :: View c () -> View c ()\nli' = tag \"li\"\n\nfooter :: View c () -> View c ()\nfooter = tag \"footer\"\n"
  },
  {
    "path": "demo/Example/Trigger.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Example.Trigger where\n\nimport Data.Text (Text)\nimport App.Docs\nimport Example.Style.Cyber as Cyber (btn, font)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ndata Targeted = Targeted\n  deriving (Generic, ViewId)\n\ninstance HyperView Targeted es where\n  data Action Targeted = SetMessage Text\n    deriving (Generic, ViewAction)\n\n  update (SetMessage msg) = do\n    pure $ targetedView msg\n\ntargetedView :: Text -> View Targeted ()\ntargetedView msg = do\n  el ~ pad 10 . border 1 . Cyber.font $ do\n    text msg\n\ndata Controls = Controls\n  deriving (Generic, ViewId)\n\ninstance HyperView Controls es where\n  type Require Controls = '[Targeted]\n\n  data Action Controls = TriggerMessage\n    deriving (Generic, ViewAction)\n\n  update TriggerMessage = do\n    trigger Targeted $ SetMessage \"Triggered!\"\n    pure controlView\n\ncontrolView :: View Controls ()\ncontrolView = do\n  button TriggerMessage ~ btn $ \"Trigger Message\"\n\ntargetView :: View Controls ()\ntargetView = do\n  target Targeted () $ do\n    button (SetMessage \"Targeted!\") ~ btn $ \"Target SetMessage\"\n\nsource :: ModuleSource\nsource = $(moduleSource)\n"
  },
  {
    "path": "demo/Example/View/Icon.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.View.Icon where\n\nimport Data.String.Interpolate (i)\nimport Data.Text (Text)\nimport Web.Atomic.CSS\nimport Web.Hyperbole.View\n\nhamburger :: View c ()\nhamburger =\n  raw\n    [i|\n<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"none\" viewBox=\"0 0 24 24\" stroke-width=\"1.5\" stroke=\"currentColor\" class=\"size-6\">\n  <path stroke-linecap=\"round\" stroke-linejoin=\"round\" d=\"M3.75 6.75h16.5M3.75 12h16.5m-16.5 5.25h16.5\" />\n</svg>|]\n\nxCircle :: View c ()\nxCircle = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"none\" viewBox=\"0 0 24 24\" stroke-width=\"1.5\" stroke=\"currentColor\" class=\"w-6 h-6\">\n  <path stroke-linecap=\"round\" stroke-linejoin=\"round\" d=\"M9.75 9.75l4.5 4.5m0-4.5l-4.5 4.5M21 12a9 9 0 11-18 0 9 9 0 0118 0z\" />\n</svg>|]\n\ncheckCircle :: View c ()\ncheckCircle = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"none\" viewBox=\"0 0 24 24\" stroke-width=\"1.5\" stroke=\"currentColor\" class=\"size-6\">\n  <path stroke-linecap=\"round\" stroke-linejoin=\"round\" d=\"M9 12.75 11.25 15 15 9.75M21 12a9 9 0 1 1-18 0 9 9 0 0 1 18 0Z\" />\n</svg>|]\n\ncheck :: View c ()\ncheck = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"none\" viewBox=\"0 0 24 24\" stroke-width=\"1.5\" stroke=\"currentColor\" class=\"size-6\">\n  <path stroke-linecap=\"round\" stroke-linejoin=\"round\" d=\"m4.5 12.75 6 6 9-13.5\" />\n</svg>|]\n\nchevronDown :: View c ()\nchevronDown = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"none\" viewBox=\"0 0 24 24\" stroke-width=\"1.5\" stroke=\"currentColor\" class=\"size-6\">\n  <path stroke-linecap=\"round\" stroke-linejoin=\"round\" d=\"m19.5 8.25-7.5 7.5-7.5-7.5\" />\n</svg>|]\n\n-- Haskell logo\n-- https://commons.wikimedia.org/wiki/File:Haskell-Logo.svg\nhaskell :: View c ()\nhaskell = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" fill=\"currentColor\" viewBox=\"0 0 17 12\">\n\t<path d=\"M 0 12 L 4 6 L 0 0 L 3 0 L 7 6 L 3 12\"/>\n\t<path d=\"M 4 12 L 8 6 L 4 0 L 7 0 L 15 12 L 12 12 L 9.5 8.25 L 7 12\"/>\n\t<path d=\"M 13.66 8.5 L 12.333 6.5 L 17 6.5 L 17 8.5 M 11.666 5.5 L 10.333 3.5 L 17 3.5 L 17 5.5\"/>\n</svg>|]\n\n-- GitHub logo\ngithub :: View c ()\ngithub = raw $ do\n  [i|<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 24 24\" fill=\"currentColor\">\n  <path d=\"M10.226 17.284c-2.965-.36-5.054-2.493-5.054-5.256 0-1.123.404-2.336 1.078-3.144-.292-.741-.247-2.314.09-2.965.898-.112 2.111.36 2.83 1.01.853-.269 1.752-.404 2.853-.404 1.1 0 1.999.135 2.807.382.696-.629 1.932-1.1 2.83-.988.315.606.36 2.179.067 2.942.72.854 1.101 2 1.101 3.167 0 2.763-2.089 4.852-5.098 5.234.763.494 1.28 1.572 1.28 2.807v2.336c0 .674.561 1.056 1.235.786 4.066-1.55 7.255-5.615 7.255-10.646C23.5 6.188 18.334 1 11.978 1 5.62 1 .5 6.188.5 12.545c0 4.986 3.167 9.12 7.435 10.669.606.225 1.19-.18 1.19-.786V20.63a2.9 2.9 0 0 1-1.078.224c-1.483 0-2.359-.808-2.987-2.313-.247-.607-.517-.966-1.034-1.033-.27-.023-.359-.135-.359-.27 0-.27.45-.471.898-.471.652 0 1.213.404 1.797 1.235.45.651.921.943 1.483.943.561 0 .92-.202 1.437-.719.382-.381.674-.718.944-.943\"></path>\n</svg>|]\n\n-- see icons.svg\nicon :: Text -> View c ()\nicon iconId = tag \"svg\" ~ icn $ do\n  tag \"use\" @ att \"href\" (\"/icons.svg#\" <> iconId) $ none\n where\n  icn =\n    utility\n      \"icn\"\n      [ \"width\" :. \"1.2em\"\n      , \"height\" :. \"1.2em\"\n      , \"display\" :. \"inline-block\"\n      , \"fill\" :. \"none\"\n      , \"stroke\" :. \"current-color\"\n      , \"transform\" :. \"translateY(0.175em)\"\n      ]\n\nbookOpen :: View c ()\nbookOpen = icon \"book\"\n\nlinkOut :: View c ()\nlinkOut = icon \"link-out\"\n\niconInline :: (Styleable h) => CSS h -> CSS h\niconInline = flexRow . gap 2 . utility \"items-baseline\" [\"align-items\" :. \"baseline\"]\n"
  },
  {
    "path": "demo/Example/View/Inputs.hs",
    "content": "module Example.View.Inputs where\n\nimport Example.Colors\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ntoggleCheckbox :: (ViewAction (Action id)) => (Bool -> Action id) -> Bool -> View id ()\ntoggleCheckbox setChecked isSelected = do\n  tag \"input\" @ att \"type\" \"checkbox\" . onClick (setChecked (not isSelected)) . checked isSelected ~ big $ none\n where\n  big = width 32 . height 32\n\nprogressBar :: Float -> View context () -> View context ()\nprogressBar pct contents = do\n  let setWidth = if pct > 0 then width (Pct pct) else id\n  row ~ bg Light $ do\n    row ~ bg PrimaryLight . setWidth . pad 5 $ contents\n"
  },
  {
    "path": "demo/Example/View/Layout.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.View.Layout where\n\nimport App.Docs (PageAnchor (..))\nimport App.Route\nimport Data.String.Conversions (cs)\nimport Data.Version (showVersion)\nimport Example.Colors (AppColor (..))\nimport Example.Style qualified as Style\nimport Example.Style.Cyber qualified as Cyber\nimport Example.View.Icon as Icon (github, hamburger, haskell)\nimport Example.View.Menu (menu)\nimport Paths_demo (version)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nlayout :: AppRoute -> View c () -> View c ()\nlayout rt = layout' (menu @() rt)\n\nlayoutSubnav :: forall sections c. (PageAnchor sections) => AppRoute -> View c () -> View c ()\nlayoutSubnav rt = layout' (menu @sections rt)\n\nlayout' :: View c () -> View c () -> View c ()\nlayout' chosenMenu contents =\n  el ~ grow $ do\n    navigation chosenMenu ~ position Fixed . zIndex 1 . onDesktop leftMenu . onMobile topMenu\n    col ~ pad (TRBL 25 25 100 25) . gap 30 . onDesktop horizontal . onMobile vertical $ do\n      contents\n where\n  leftMenu = width menuWidth . left 0 . top 0 . bottom 0\n  horizontal = margin (L menuWidth)\n  vertical = margin (T menuHeight)\n\n  topMenu = top 0 . right 0 . left 0\n\n  menuWidth = 230\n  menuHeight = 70\n\n-- Navigation --------------------------------------\n\nnavigation :: View c () -> View c ()\nnavigation chosenMenu = do\n  nav ~ bg Dark . color White . flexCol . showMenuHover $ do\n    row $ do\n      link hackageUrl \"HYPERBOLE\" ~ bold . pad 20 . logo . width 220\n      space\n      menuButton\n    col ~ cls \"menu\" . onMobile (display None) . Cyber.font . Style.uppercase $ do\n      chosenMenu\n      space\n      row ~ pad (TL 20 10) . gap 10 . utility \"items-center\" [\"align-items\" :. \"center\"] $ do\n        el ~ fontSize 12 $ do\n          text \"v\"\n          text $ cs $ showVersion version\n        row $ do\n          link hackageUrl (el ~ width 20 . height 20 . flexRow . utility \"items-center\" [\"align-items\" :. \"center\"] $ Icon.haskell) ~ pad 8 . hover (bg DarkHighlight)\n          link githubUrl (el ~ width 20 . height 20 . flexRow . utility \"items-center\" [\"align-items\" :. \"center\"] $ Icon.github) ~ pad 8 . hover (bg DarkHighlight)\n where\n  hackageUrl = [uri|https://hackage.haskell.org/package/hyperbole|]\n  githubUrl = [uri|https://github.com/seanhess/hyperbole|]\n\n  menuButton =\n    el ~ onDesktop (display None) . onMobile flexCol $ do\n      el ~ pad 6 $ do\n        el Icon.hamburger ~ color White . width 50 . height 50\n\n  showMenuHover =\n    css\n      \"show-menu\"\n      \".show-menu:hover > .menu\"\n      [ \"display\" :. \"flex\"\n      ]\n\n  -- https://www.fontspace.com/super-brigade-font-f96444\n  logo =\n    utility\n      \"logo\"\n      [ \"background\" :. \"no-repeat center/90% url(/logo-robot.png)\"\n      , \"color\" :. \"transparent\"\n      ]\n\nonMobile :: (Styleable c) => (CSS c -> CSS c) -> CSS c -> CSS c\nonMobile = media (MaxWidth 650)\n\nonDesktop :: (Styleable c) => (CSS c -> CSS c) -> CSS c -> CSS c\nonDesktop = media (MinWidth 650)\n"
  },
  {
    "path": "demo/Example/View/Loader.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Example.View.Loader where\n\nimport Data.ByteString (ByteString)\nimport Data.String.Interpolate (i)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\ncss :: ByteString\ncss =\n  [i|\n.loader {\n  width: 24px;\n  aspect-ratio: 1;\n  --c: no-repeat linear-gradient(\\#E44072 0 0);\n  background: \n    var(--c) 0%   50%,\n    var(--c) 50%  50%,\n    var(--c) 100% 50%;\n  background-size: 20% 100%;\n  animation: l1 1s infinite linear;\n}\n@keyframes l1 {\n  0%  {background-size: 20% 100%,20% 100%,20% 100%}\n  33% {background-size: 20% 10% ,20% 100%,20% 100%}\n  50% {background-size: 20% 100%,20% 10% ,20% 100%}\n  66% {background-size: 20% 100%,20% 100%,20% 10% }\n  100%{background-size: 20% 100%,20% 100%,20% 100%}\n}\n|]\n\nloadingBars :: View c ()\nloadingBars = el ~ cls \"loader\" $ none\n\nloading :: View c ()\nloading = do\n  row ~ gap 10 . whenLoading flexRow . display None $ do\n    loadingBars\n    el \"Loading...\"\n"
  },
  {
    "path": "demo/Example/View/Menu.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Example.View.Menu where\n\nimport App.Docs\nimport App.Route\nimport Control.Monad (when)\nimport Example.Colors (AppColor (..), cyan)\nimport Web.Atomic.CSS\nimport Web.Hyperbole\n\nmenu :: forall sections c. (PageAnchor sections) => AppRoute -> View c ()\nmenu current = do\n  col ~ color White $ do\n    docLink Intro\n    docLink Basics\n    docLink Hyperviews\n    docLink Concurrency\n    docLink ViewFunctions\n    docLink SideEffects\n    docLink State\n    docLink CSS\n    docLink HyperboleEffect\n    docLink Application\n    docLink (Forms FormSimple)\n    docLink Interactivity\n    docLink' isExamples (Examples OtherExamples)\n where\n  -- case current of\n  --   Examples _ ->\n  --     completeExamples\n  --   (Contacts _) ->\n  --     completeExamples\n  --   _ -> none\n\n  -- completeExamples = do\n  --   subLink (Examples Tags)\n  --   subLink (Contacts ContactsAll)\n  --   subLink (Examples OAuth2)\n  --   subLink (Examples Todos)\n  --   subLink (Examples TodosCSS)\n\n  isExamples =\n    case current of\n      Examples _ -> True\n      Data _ -> True\n      Contacts _ -> True\n      _ -> False\n\n  sub = pad (TRBL 5 10 5 40) . fontSize 14\n\n  menuItem :: (Styleable h) => CSS h -> CSS h\n  menuItem =\n    pad (XY 20 10) . hover (bg DarkHighlight)\n\n  docLink rt = docLink' (rt == current) rt\n\n  docLink' isSelected rt = do\n    let highlight = if isSelected then bg DarkHighlight . border (L 4) . pad (L 16) . color cyan else id\n    route rt ~ highlight . menuItem $\n      text $\n        routeTitle\n          rt\n    when (rt == current) $ do\n      mapM_ anchorLink (subnav @sections)\n\n  -- subLink rt = do\n  --   let isSelected = rt == current\n  --   let highlight = if isSelected then bg DarkHighlight . color cyan else id -- border (L 4) . pad (L 16) . color cyan else id\n  --   route rt ~ highlight . sub . menuItem $\n  --     text $\n  --       routeTitle rt\n\n  anchorLink :: (PageAnchor a) => a -> View c ()\n  anchorLink a = do\n    tag \"a\" ~ sub . menuItem @ att \"href\" (\"#\" <> pageAnchor a) $ do\n      text $ navEntry a\n"
  },
  {
    "path": "demo/Example/View/SortableTable.hs",
    "content": "module Example.View.SortableTable where\n\nimport Data.Text (Text)\nimport Example.Colors\nimport Example.Style qualified as Style\nimport Example.View.Icon qualified as Icon\nimport Web.Atomic.CSS\nimport Web.Hyperbole\nimport Prelude hiding (even, odd)\n\ndataRow :: (Styleable a) => CSS a -> CSS a\ndataRow = gap 10 . pad (All $ PxRem dataRowPadding)\n\ndataRowPadding :: PxRem\ndataRowPadding = 5\n\nbord :: (Styleable a) => CSS a -> CSS a\nbord = border 1 . borderColor Light\n\nhd :: View id () -> TableHead id ()\nhd = th ~ pad 4 . bord . bg Light\n\ncell :: (Styleable a) => CSS a -> CSS a\ncell = pad 4 . bord\n\ndataTable :: (Styleable a) => CSS a -> CSS a\ndataTable =\n  css\n    \"data-table\"\n    \".data-table tr:nth-child(even)\"\n    (declarations (bg Light))\n\nsortBtn :: (ViewAction (Action id)) => Text -> Action id -> Bool -> View id ()\nsortBtn lbl click isSelected = do\n  button click ~ Style.link . flexRow . gap 0 $ do\n    el ~ selectedColumn $ text lbl\n    el ~ width 20 $ Icon.chevronDown\n where\n  selectedColumn =\n    if isSelected\n      then underline\n      else id\n\nsortColumn :: (ViewAction (Action id)) => View id () -> (dt -> Text) -> TableColumns id dt ()\nsortColumn header cellText = do\n  tcol (hd header) $ \\item ->\n    td ~ cell $ text $ cellText item\n"
  },
  {
    "path": "demo/Main.hs",
    "content": "module Main where\n\nimport App\n\nmain :: IO ()\nmain = App.run\n"
  },
  {
    "path": "demo/README.md",
    "content": "Hyperbole Examples\n===================\n\nVisit https://docs.hyperbole.live to view these examples with source code\n"
  },
  {
    "path": "demo/demo.cabal",
    "content": "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.com/sol/hpack\n\nname:           demo\nversion:        0.6.0\nsynopsis:       Interactive HTML apps using type-safe serverside Haskell\ndescription:    Interactive HTML applications using type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView\ncategory:       Web, Network\nhomepage:       https://github.com/seanhess/hyperbole\nbug-reports:    https://github.com/seanhess/hyperbole/issues\nauthor:         Sean Hess\nmaintainer:     seanhess@gmail.com\nlicense:        BSD-3-Clause\nbuild-type:     Simple\n\nsource-repository head\n  type: git\n  location: https://github.com/seanhess/hyperbole\n\nexecutable demo\n  main-is: Main.hs\n  other-modules:\n      App\n      App.Cache\n      App.Config\n      App.Docs\n      App.Docs.Markdown\n      App.Docs.Page\n      App.Docs.Snippet\n      App.Page.Application\n      App.Page.Concurrency\n      App.Page.CSS\n      App.Page.Examples\n      App.Page.Forms\n      App.Page.HyperboleEffect\n      App.Page.Hyperviews\n      App.Page.Interactivity\n      App.Page.Intro.Basics\n      App.Page.Intro.Intro\n      App.Page.OAuth2\n      App.Page.SideEffects\n      App.Page.State\n      App.Page.ViewFunctions\n      App.Route\n      App.Style\n      Example.Chat\n      Example.Colors\n      Example.Concurrency.LazyLoading\n      Example.Concurrency.Overlap\n      Example.Concurrency.Polling\n      Example.Concurrency.Progress\n      Example.Concurrency.Tasks\n      Example.Contact\n      Example.Contacts\n      Example.Counter\n      Example.CSS.External\n      Example.CSS.Loading\n      Example.CSS.Tooltips\n      Example.CSS.Transitions\n      Example.Data.ProgrammingLanguage\n      Example.DataLists.Autocomplete\n      Example.DataLists.DataTable\n      Example.DataLists.Filter\n      Example.DataLists.LoadMore\n      Example.Docs.App\n      Example.Docs.BasicPage\n      Example.Docs.Client\n      Example.Docs.Component\n      Example.Docs.CSS\n      Example.Docs.Encoding\n      Example.Docs.Interactive\n      Example.Docs.MultiPage\n      Example.Docs.MultiView\n      Example.Docs.Nested\n      Example.Docs.Nesting\n      Example.Docs.Page.Messages\n      Example.Docs.Page.Users\n      Example.Docs.Params\n      Example.Docs.QueryMessage\n      Example.Docs.Sessions\n      Example.Docs.SideEffects\n      Example.Docs.State\n      Example.Docs.UniqueViewId\n      Example.Docs.ViewFunctions\n      Example.Document\n      Example.Effects.Debug\n      Example.Effects.Todos\n      Example.Effects.Users\n      Example.Errors\n      Example.FormSimple\n      Example.FormValidation\n      Example.Interactivity.Events\n      Example.Interactivity.Inputs\n      Example.Javascript\n      Example.Push\n      Example.Requests\n      Example.Scrollbars\n      Example.Simple\n      Example.State.Effects\n      Example.State.Query\n      Example.State.Sessions\n      Example.State.Stateless\n      Example.State.ViewState\n      Example.Style\n      Example.Style.Cyber\n      Example.Tags\n      Example.Test\n      Example.Todos.Todo\n      Example.Todos.TodoCSS\n      Example.Trigger\n      Example.View.Icon\n      Example.View.Inputs\n      Example.View.Layout\n      Example.View.Loader\n      Example.View.Menu\n      Example.View.SortableTable\n      Paths_demo\n  autogen-modules:\n      Paths_demo\n  hs-source-dirs:\n      ./\n  default-extensions:\n      OverloadedStrings\n      OverloadedRecordDot\n      DuplicateRecordFields\n      NoFieldSelectors\n      TypeFamilies\n      DataKinds\n      DerivingStrategies\n      DeriveAnyClass\n  ghc-options: -Wall -fdefer-typed-holes -threaded -rtsopts -with-rtsopts=-N\n  build-depends:\n      aeson\n    , atomic-css\n    , base\n    , bytestring\n    , casing\n    , cmark\n    , containers\n    , cookie\n    , data-default\n    , directory\n    , effectful\n    , file-embed\n    , filepath\n    , foreign-store\n    , http-api-data\n    , http-client\n    , http-client-tls\n    , http-types\n    , hyperbole\n    , network\n    , network-uri\n    , random\n    , safe\n    , string-conversions\n    , string-interpolate\n    , template-haskell\n    , text\n    , time\n    , wai\n    , wai-middleware-static\n    , wai-websockets\n    , warp\n    , websockets\n  default-language: GHC2021\n"
  },
  {
    "path": "demo/fourmolu.yaml",
    "content": "# # Number of spaces per indentation step\nindentation: 2\n#\n# # Max line length for automatic line breaking\n# column-limit: none\n\n# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)\nfunction-arrows: leading\n\n# # How to place commas in multi-line lists, records, etc. (choices: leading or trailing)\n# comma-style: leading\n\n# Styling of import/export lists (choices: leading, trailing, or diff-friendly)\nimport-export-style: leading\n\n# # Whether to full-indent or half-indent 'where' bindings past the preceding body\n# indent-wheres: false\n#\n# # Whether to leave a space before an opening record brace\n# record-brace-space: false\n\n# # Number of spaces between top-level declarations\nnewlines-between-decls: 1\n#\n# # How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)\n# haddock-style: multi-line\n#\n# # How to print module docstring\n# haddock-style-module: null\n\n# # Styling of let blocks (choices: auto, inline, newline, or mixed)\n# let-style: auto\n#\n# # How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)\n# in-style: right-align\n#\n# # Whether to put parentheses around a single constraint (choices: auto, always, or never)\n# single-constraint-parens: always\n#\n# # Output Unicode syntax (choices: detect, always, or never)\n# unicode: never\n#\n# Give the programmer more choice on where to insert blank lines\nrespectful: true\n\n# # Fixity information for operators\n# fixities: []\n#\n# # Module reexports Fourmolu should know about\n# reexports: []\n\n"
  },
  {
    "path": "demo/hie.yaml",
    "content": "cradle:\n  cabal:\n"
  },
  {
    "path": "demo/package.yaml",
    "content": "name:               demo\nversion:            0.6.0\nsynopsis:           Interactive HTML apps using type-safe serverside Haskell\nhomepage:           https://github.com/seanhess/hyperbole\ngithub:             seanhess/hyperbole\nlicense:            BSD-3-Clause\nauthor:             Sean Hess\nmaintainer:         seanhess@gmail.com\ncategory:           Web, Network\ndescription:        Interactive HTML applications using type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView\n\nlanguage: GHC2021\n\nghc-options:\n  - -Wall\n  - -fdefer-typed-holes\n\ndefault-extensions:\n  - OverloadedStrings\n  - OverloadedRecordDot\n  - DuplicateRecordFields\n  - NoFieldSelectors\n  - TypeFamilies\n  - DataKinds\n  - DerivingStrategies\n  - DeriveAnyClass\n\ndependencies:\n  - base\n  - aeson\n  - bytestring\n  - containers\n  - casing\n  - data-default\n  - effectful\n  - text\n  - time\n  - string-interpolate\n  - file-embed\n  - http-api-data\n  - http-types\n  - random\n  - wai\n  - warp\n  - atomic-css\n  - string-conversions\n  - wai-websockets\n  - network\n  - websockets\n  - cookie\n  - hyperbole\n  - network-uri\n  - http-client\n  - http-client-tls\n  - template-haskell\n  - cmark\n  - directory\n  - filepath\n\nexecutables:\n  demo:\n    main:                Main.hs\n    ghc-options:\n      - -threaded\n      - -rtsopts\n      - -with-rtsopts=-N\n    source-dirs:\n      - ./\n    dependencies:\n    - wai-middleware-static\n    - safe\n    - foreign-store\n"
  },
  {
    "path": "demo/static/custom.js",
    "content": "console.log(\"Custom JS!\")\n\nwindow.onload = function() {\n  let boxes = Hyperbole.hyperView(\"JBoxes\")\n  console.log(\"Found HyperView 'Boxes'\")\n\n  boxes.addEventListener(\"mouseover\", function(e) {\n    if (e.target.classList.contains(\"box\")) {\n      let action = Hyperbole.action(\"Selected\", parseInt(e.target.innerHTML))\n      boxes.runAction(action)\n    }\n  })\n  boxes.addEventListener(\"mouseout\", function(e) {\n    if (e.target.classList.contains(\"box\")) {\n      boxes.runAction(\"Clear\")\n    }\n  })\n\n  listenServerEvents()\n}\n\nfunction listenServerEvents() {\n  // you can listen on document instead, the event will bubble\n  Hyperbole.hyperView(\"Message\").addEventListener(\"server-message\", function(e) {\n    alert(\"Server Message: \" + e.detail)\n  })\n}\n"
  },
  {
    "path": "demo/static/cyber.css",
    "content": "@font-face {\n  font-family: 'Share Tech Mono';\n  src: url('/ShareTechMono-Regular.ttf') format('truetype');\n  font-weight: normal;\n  font-style: normal;\n}\n\n\n@keyframes errorFlicker {\n  0%, 50% { opacity: 0; }\n  25%, 75%, 100% { opacity: 1; }\n}\n\n@keyframes wipeIn {\n  from { clip-path: inset(0 100% 0 0); }  /* fully hidden (100% right cut) */\n  to   { clip-path: inset(0 0 0 0); }     /* fully visible */\n}\n\n\n.glitch, .live-reload {\n  color: #fff;\n  position: relative;\n  margin: 0 auto;\n  font-family: 'Share Tech Mono';\n}\n\n/* keyframes expanded from the SCSS @for + random() */\n@keyframes noise-anim {\n   00% { clip: rect(40px, 9999px, 60px, 0); }\n   05% { clip: rect(76px, 9999px, 10px, 0); }\n   10% { clip: rect(18px, 9999px, 74px, 0); }\n   15% { clip: rect(96px, 9999px, 32px, 0); }\n   20% { clip: rect(90px, 9999px, 8px, 0); }\n   25% { clip: rect(14px, 9999px, 72px, 0); }\n   30% { clip: rect(54px, 9999px, 36px, 0); }\n   35% { clip: rect(48px, 9999px, 92px, 0); }\n   40% { clip: rect(6px, 9999px, 40px, 0); }\n   45% { clip: rect(70px, 9999px, 16px, 0); }\n   50% { clip: rect(22px, 9999px, 84px, 0); }\n   55% { clip: rect(88px, 9999px, 28px, 0); }\n   60% { clip: rect(4px, 9999px, 44px, 0); }\n   65% { clip: rect(12px, 9999px, 98px, 0); }\n   70% { clip: rect(66px, 9999px, 22px, 0); }\n   75% { clip: rect(30px, 9999px, 80px, 0); }\n   80% { clip: rect(28px, 9999px, 58px, 0); }\n   85% { clip: rect(60px, 9999px, 20px, 0); }\n   90% { clip: rect(8px, 9999px, 96px, 0); }\n   95% { clip: rect(34px, 9999px, 12px, 0); }\n  100% { clip: rect(0px, 9999px, 100px, 0); }\n}\n\n@keyframes noise-anim-2 {\n    0% { clip: rect(10px, 9999px, 76px, 0); }\n    5% { clip: rect(72px, 9999px, 40px, 0); }\n   10% { clip: rect(24px, 9999px, 58px, 0); }\n   15% { clip: rect(60px, 9999px, 18px, 0); }\n   20% { clip: rect(36px, 9999px, 96px, 0); }\n   25% { clip: rect(52px, 9999px, 28px, 0); }\n   30% { clip: rect(6px, 9999px, 60px, 0); }\n   35% { clip: rect(80px, 9999px, 8px, 0); }\n   40% { clip: rect(14px, 9999px, 34px, 0); }\n   45% { clip: rect(100px, 9999px, 0px, 0); }\n   50% { clip: rect(64px, 9999px, 12px, 0); }\n   55% { clip: rect(8px, 9999px, 88px, 0); }\n   60% { clip: rect(44px, 9999px, 66px, 0); }\n   65% { clip: rect(2px, 9999px, 30px, 0); }\n   70% { clip: rect(78px, 9999px, 24px, 0); }\n   75% { clip: rect(20px, 9999px, 92px, 0); }\n   80% { clip: rect(86px, 9999px, 14px, 0); }\n   85% { clip: rect(32px, 9999px, 70px, 0); }\n   90% { clip: rect(58px, 9999px, 6px, 0); }\n   95% { clip: rect(16px, 9999px, 48px, 0); }\n  100% { clip: rect(94px, 9999px, 22px, 0); }\n}\n\n/* red/blue channel splits */\n.glitch::after {\n  content: attr(data-text);\n  position: absolute;\n  left: 2px;\n  top: 0;\n  color: #fff;\n  text-shadow: -1px 0 #f00;\n  background: transparent;\n  overflow: hidden;\n  clip: rect(0, 900px, 0, 0);\n  animation: noise-anim 1s linear alternate-reverse;\n}\n\n.glitch::before {\n  content: attr(data-text);\n  position: absolute;\n  left: -2px;\n  top: 0;\n  color: #fff;\n  text-shadow: 1px 0 #00f;\n  background: transparent;\n  overflow: hidden;\n  clip: rect(0, 900px, 0, 0);\n  animation: noise-anim-2 1s linear alternate-reverse;\n}\n\n\n\npre[class*=\"language-\"],\ncode[class*=\"language-\"] {\n  font-size: inherit;\n}\n\n\n.nav-active {\n  color: #0FF;\n}\n"
  },
  {
    "path": "demo/static/docs.js",
    "content": "\nconsole.log(\"CUSTOM DOCS JS 2\")\n\nconst sections = document.querySelectorAll(\"section[id]\")\nconst navLinks = document.querySelectorAll('nav a[href^=\"#\"]')\nlet isNavigating = false\n\n\nconst obs = new IntersectionObserver((entries) => {\n\n  // Pick the most visible intersecting section\n  const visible = entries\n    .filter(e => e.isIntersecting)\n    .sort((a, b) => b.intersectionRatio - a.intersectionRatio);\n\n  if (!visible[0] || !visible[0].target.id) return\n\n\n  const activeId = visible[0].target.id\n  console.log(\"VISIBLE\", activeId)\n\n  if (!isNavigating) {\n    highlightNav(activeId)\n  }\n\n\n  // Optional: keep URL in sync without jump\n  history.replaceState(null, \"\", `#${activeId}`);\n\n}, { threshold: 0, rootMargin: \"-10% 0px -80% 0px\", });\n\nsections.forEach(s => obs.observe(s));\n\nfunction highlightNav(activeId) {\n  console.log(\"highlightNav\", activeId)\n  const activeLink = document.querySelector('nav a[href^=\"#' + activeId + '\"]')\n  navLinks.forEach(a => a.classList.remove('nav-active'))\n  activeLink.classList.add('nav-active')\n}\n\nwindow.addEventListener('popstate', function(event) {\n  console.log(\"popstate\", event, window.location.hash)\n  isNavigating = true\n\n  if (window.location.hash) {\n    highlightNav(window.location.hash.substring(1))\n  }\n});\n\n\n\n// window.addEventListener('scroll', (_event) => {\n//   console.log('scroll');\n//   isScrolling = true\n// })\n\nwindow.addEventListener('scrollend', (_event) => {\n  console.log('scrollend');\n  isNavigating = false\n});\n"
  },
  {
    "path": "demo/static/external.css",
    "content": ".item {\n  border: 1px dashed;\n  padding: 5px;\n  padding-left: 10px;\n  padding-right: 10px;\n}\n\n.item:hover {\n  border-color: blue;\n  color: blue;\n}\n\n.parent {\n  display: flex;\n  flex-direction: row;\n  gap: 10px;\n  padding: 10px;\n  background-color: white;\n}\n\n.selected {\n  font-weight: bold;\n  border-width: 2px;\n  padding: 4px;\n  padding-left: 9px;\n  padding-right: 9px;\n}\n"
  },
  {
    "path": "demo/static/prism.css",
    "content": "/* PrismJS 1.30.0\nhttps://prismjs.com/download#themes=prism-okaidia&languages=markup+css+clike+javascript+haskell */\ncode[class*=language-],pre[class*=language-]{color:#f8f8f2;background:0 0;text-shadow:0 1px rgba(0,0,0,.3);font-family:Consolas,Monaco,'Andale Mono','Ubuntu Mono',monospace;font-size:0.875rem;text-align:left;white-space:pre;word-spacing:normal;word-break:normal;word-wrap:normal;line-height:1.5;-moz-tab-size:4;-o-tab-size:4;tab-size:4;-webkit-hyphens:none;-moz-hyphens:none;-ms-hyphens:none;hyphens:none}pre[class*=language-]{padding:1em;margin:.5em 0;overflow:auto;border-radius:.3em}:not(pre)>code[class*=language-],pre[class*=language-]{background:#272822}:not(pre)>code[class*=language-]{padding:.1em;border-radius:.3em;white-space:normal}.token.cdata,.token.comment,.token.doctype,.token.prolog{color:#8292a2}.token.punctuation{color:#f8f8f2}.token.namespace{opacity:.7}.token.constant,.token.deleted,.token.property,.token.symbol,.token.tag{color:#f92672}.token.boolean,.token.number{color:#ae81ff}.token.attr-name,.token.builtin,.token.char,.token.inserted,.token.selector,.token.string{color:#a6e22e}.language-css .token.string,.style .token.string,.token.entity,.token.operator,.token.url,.token.variable{color:#f8f8f2}.token.atrule,.token.attr-value,.token.class-name,.token.function{color:#e6db74}.token.keyword{color:#66d9ef}.token.important,.token.regex{color:#fd971f}.token.bold,.token.important{font-weight:700}.token.italic{font-style:italic}.token.entity{cursor:help}\n"
  },
  {
    "path": "demo/static/prism.js",
    "content": "/* PrismJS 1.30.0\nhttps://prismjs.com/download#themes=prism&languages=markup+css+clike+javascript+haskell */\nvar _self=\"undefined\"!=typeof window?window:\"undefined\"!=typeof WorkerGlobalScope&&self instanceof WorkerGlobalScope?self:{},Prism=function(e){var n=/(?:^|\\s)lang(?:uage)?-([\\w-]+)(?=\\s|$)/i,t=0,r={},a={manual:e.Prism&&e.Prism.manual,disableWorkerMessageHandler:e.Prism&&e.Prism.disableWorkerMessageHandler,util:{encode:function e(n){return n instanceof i?new i(n.type,e(n.content),n.alias):Array.isArray(n)?n.map(e):n.replace(/&/g,\"&amp;\").replace(/</g,\"&lt;\").replace(/\\u00a0/g,\" \")},type:function(e){return Object.prototype.toString.call(e).slice(8,-1)},objId:function(e){return e.__id||Object.defineProperty(e,\"__id\",{value:++t}),e.__id},clone:function e(n,t){var r,i;switch(t=t||{},a.util.type(n)){case\"Object\":if(i=a.util.objId(n),t[i])return t[i];for(var l in r={},t[i]=r,n)n.hasOwnProperty(l)&&(r[l]=e(n[l],t));return r;case\"Array\":return i=a.util.objId(n),t[i]?t[i]:(r=[],t[i]=r,n.forEach((function(n,a){r[a]=e(n,t)})),r);default:return n}},getLanguage:function(e){for(;e;){var t=n.exec(e.className);if(t)return t[1].toLowerCase();e=e.parentElement}return\"none\"},setLanguage:function(e,t){e.className=e.className.replace(RegExp(n,\"gi\"),\"\"),e.classList.add(\"language-\"+t)},currentScript:function(){if(\"undefined\"==typeof document)return null;if(document.currentScript&&\"SCRIPT\"===document.currentScript.tagName)return document.currentScript;try{throw new Error}catch(r){var e=(/at [^(\\r\\n]*\\((.*):[^:]+:[^:]+\\)$/i.exec(r.stack)||[])[1];if(e){var n=document.getElementsByTagName(\"script\");for(var t in n)if(n[t].src==e)return n[t]}return null}},isActive:function(e,n,t){for(var r=\"no-\"+n;e;){var a=e.classList;if(a.contains(n))return!0;if(a.contains(r))return!1;e=e.parentElement}return!!t}},languages:{plain:r,plaintext:r,text:r,txt:r,extend:function(e,n){var t=a.util.clone(a.languages[e]);for(var r in n)t[r]=n[r];return t},insertBefore:function(e,n,t,r){var i=(r=r||a.languages)[e],l={};for(var o in i)if(i.hasOwnProperty(o)){if(o==n)for(var s in t)t.hasOwnProperty(s)&&(l[s]=t[s]);t.hasOwnProperty(o)||(l[o]=i[o])}var u=r[e];return r[e]=l,a.languages.DFS(a.languages,(function(n,t){t===u&&n!=e&&(this[n]=l)})),l},DFS:function e(n,t,r,i){i=i||{};var l=a.util.objId;for(var o in n)if(n.hasOwnProperty(o)){t.call(n,o,n[o],r||o);var s=n[o],u=a.util.type(s);\"Object\"!==u||i[l(s)]?\"Array\"!==u||i[l(s)]||(i[l(s)]=!0,e(s,t,o,i)):(i[l(s)]=!0,e(s,t,null,i))}}},plugins:{},highlightAll:function(e,n){a.highlightAllUnder(document,e,n)},highlightAllUnder:function(e,n,t){var r={callback:t,container:e,selector:'code[class*=\"language-\"], [class*=\"language-\"] code, code[class*=\"lang-\"], [class*=\"lang-\"] code'};a.hooks.run(\"before-highlightall\",r),r.elements=Array.prototype.slice.apply(r.container.querySelectorAll(r.selector)),a.hooks.run(\"before-all-elements-highlight\",r);for(var i,l=0;i=r.elements[l++];)a.highlightElement(i,!0===n,r.callback)},highlightElement:function(n,t,r){var i=a.util.getLanguage(n),l=a.languages[i];a.util.setLanguage(n,i);var o=n.parentElement;o&&\"pre\"===o.nodeName.toLowerCase()&&a.util.setLanguage(o,i);var s={element:n,language:i,grammar:l,code:n.textContent};function u(e){s.highlightedCode=e,a.hooks.run(\"before-insert\",s),s.element.innerHTML=s.highlightedCode,a.hooks.run(\"after-highlight\",s),a.hooks.run(\"complete\",s),r&&r.call(s.element)}if(a.hooks.run(\"before-sanity-check\",s),(o=s.element.parentElement)&&\"pre\"===o.nodeName.toLowerCase()&&!o.hasAttribute(\"tabindex\")&&o.setAttribute(\"tabindex\",\"0\"),!s.code)return a.hooks.run(\"complete\",s),void(r&&r.call(s.element));if(a.hooks.run(\"before-highlight\",s),s.grammar)if(t&&e.Worker){var c=new Worker(a.filename);c.onmessage=function(e){u(e.data)},c.postMessage(JSON.stringify({language:s.language,code:s.code,immediateClose:!0}))}else u(a.highlight(s.code,s.grammar,s.language));else u(a.util.encode(s.code))},highlight:function(e,n,t){var r={code:e,grammar:n,language:t};if(a.hooks.run(\"before-tokenize\",r),!r.grammar)throw new Error('The language \"'+r.language+'\" has no grammar.');return r.tokens=a.tokenize(r.code,r.grammar),a.hooks.run(\"after-tokenize\",r),i.stringify(a.util.encode(r.tokens),r.language)},tokenize:function(e,n){var t=n.rest;if(t){for(var r in t)n[r]=t[r];delete n.rest}var a=new s;return u(a,a.head,e),o(e,a,n,a.head,0),function(e){for(var n=[],t=e.head.next;t!==e.tail;)n.push(t.value),t=t.next;return n}(a)},hooks:{all:{},add:function(e,n){var t=a.hooks.all;t[e]=t[e]||[],t[e].push(n)},run:function(e,n){var t=a.hooks.all[e];if(t&&t.length)for(var r,i=0;r=t[i++];)r(n)}},Token:i};function i(e,n,t,r){this.type=e,this.content=n,this.alias=t,this.length=0|(r||\"\").length}function l(e,n,t,r){e.lastIndex=n;var a=e.exec(t);if(a&&r&&a[1]){var i=a[1].length;a.index+=i,a[0]=a[0].slice(i)}return a}function o(e,n,t,r,s,g){for(var f in t)if(t.hasOwnProperty(f)&&t[f]){var h=t[f];h=Array.isArray(h)?h:[h];for(var d=0;d<h.length;++d){if(g&&g.cause==f+\",\"+d)return;var v=h[d],p=v.inside,m=!!v.lookbehind,y=!!v.greedy,k=v.alias;if(y&&!v.pattern.global){var x=v.pattern.toString().match(/[imsuy]*$/)[0];v.pattern=RegExp(v.pattern.source,x+\"g\")}for(var b=v.pattern||v,w=r.next,A=s;w!==n.tail&&!(g&&A>=g.reach);A+=w.value.length,w=w.next){var P=w.value;if(n.length>e.length)return;if(!(P instanceof i)){var E,S=1;if(y){if(!(E=l(b,A,e,m))||E.index>=e.length)break;var L=E.index,O=E.index+E[0].length,C=A;for(C+=w.value.length;L>=C;)C+=(w=w.next).value.length;if(A=C-=w.value.length,w.value instanceof i)continue;for(var j=w;j!==n.tail&&(C<O||\"string\"==typeof j.value);j=j.next)S++,C+=j.value.length;S--,P=e.slice(A,C),E.index-=A}else if(!(E=l(b,0,P,m)))continue;L=E.index;var N=E[0],_=P.slice(0,L),M=P.slice(L+N.length),W=A+P.length;g&&W>g.reach&&(g.reach=W);var I=w.prev;if(_&&(I=u(n,I,_),A+=_.length),c(n,I,S),w=u(n,I,new i(f,p?a.tokenize(N,p):N,k,N)),M&&u(n,w,M),S>1){var T={cause:f+\",\"+d,reach:W};o(e,n,t,w.prev,A,T),g&&T.reach>g.reach&&(g.reach=T.reach)}}}}}}function s(){var e={value:null,prev:null,next:null},n={value:null,prev:e,next:null};e.next=n,this.head=e,this.tail=n,this.length=0}function u(e,n,t){var r=n.next,a={value:t,prev:n,next:r};return n.next=a,r.prev=a,e.length++,a}function c(e,n,t){for(var r=n.next,a=0;a<t&&r!==e.tail;a++)r=r.next;n.next=r,r.prev=n,e.length-=a}if(e.Prism=a,i.stringify=function e(n,t){if(\"string\"==typeof n)return n;if(Array.isArray(n)){var r=\"\";return n.forEach((function(n){r+=e(n,t)})),r}var i={type:n.type,content:e(n.content,t),tag:\"span\",classes:[\"token\",n.type],attributes:{},language:t},l=n.alias;l&&(Array.isArray(l)?Array.prototype.push.apply(i.classes,l):i.classes.push(l)),a.hooks.run(\"wrap\",i);var o=\"\";for(var s in i.attributes)o+=\" \"+s+'=\"'+(i.attributes[s]||\"\").replace(/\"/g,\"&quot;\")+'\"';return\"<\"+i.tag+' class=\"'+i.classes.join(\" \")+'\"'+o+\">\"+i.content+\"</\"+i.tag+\">\"},!e.document)return e.addEventListener?(a.disableWorkerMessageHandler||e.addEventListener(\"message\",(function(n){var t=JSON.parse(n.data),r=t.language,i=t.code,l=t.immediateClose;e.postMessage(a.highlight(i,a.languages[r],r)),l&&e.close()}),!1),a):a;var g=a.util.currentScript();function f(){a.manual||a.highlightAll()}if(g&&(a.filename=g.src,g.hasAttribute(\"data-manual\")&&(a.manual=!0)),!a.manual){var h=document.readyState;\"loading\"===h||\"interactive\"===h&&g&&g.defer?document.addEventListener(\"DOMContentLoaded\",f):window.requestAnimationFrame?window.requestAnimationFrame(f):window.setTimeout(f,16)}return a}(_self);\"undefined\"!=typeof module&&module.exports&&(module.exports=Prism),\"undefined\"!=typeof global&&(global.Prism=Prism);\nPrism.languages.markup={comment:{pattern:/<!--(?:(?!<!--)[\\s\\S])*?-->/,greedy:!0},prolog:{pattern:/<\\?[\\s\\S]+?\\?>/,greedy:!0},doctype:{pattern:/<!DOCTYPE(?:[^>\"'[\\]]|\"[^\"]*\"|'[^']*')+(?:\\[(?:[^<\"'\\]]|\"[^\"]*\"|'[^']*'|<(?!!--)|<!--(?:[^-]|-(?!->))*-->)*\\]\\s*)?>/i,greedy:!0,inside:{\"internal-subset\":{pattern:/(^[^\\[]*\\[)[\\s\\S]+(?=\\]>$)/,lookbehind:!0,greedy:!0,inside:null},string:{pattern:/\"[^\"]*\"|'[^']*'/,greedy:!0},punctuation:/^<!|>$|[[\\]]/,\"doctype-tag\":/^DOCTYPE/i,name:/[^\\s<>'\"]+/}},cdata:{pattern:/<!\\[CDATA\\[[\\s\\S]*?\\]\\]>/i,greedy:!0},tag:{pattern:/<\\/?(?!\\d)[^\\s>\\/=$<%]+(?:\\s(?:\\s*[^\\s>\\/=]+(?:\\s*=\\s*(?:\"[^\"]*\"|'[^']*'|[^\\s'\">=]+(?=[\\s>]))|(?=[\\s/>])))+)?\\s*\\/?>/,greedy:!0,inside:{tag:{pattern:/^<\\/?[^\\s>\\/]+/,inside:{punctuation:/^<\\/?/,namespace:/^[^\\s>\\/:]+:/}},\"special-attr\":[],\"attr-value\":{pattern:/=\\s*(?:\"[^\"]*\"|'[^']*'|[^\\s'\">=]+)/,inside:{punctuation:[{pattern:/^=/,alias:\"attr-equals\"},{pattern:/^(\\s*)[\"']|[\"']$/,lookbehind:!0}]}},punctuation:/\\/?>/,\"attr-name\":{pattern:/[^\\s>\\/]+/,inside:{namespace:/^[^\\s>\\/:]+:/}}}},entity:[{pattern:/&[\\da-z]{1,8};/i,alias:\"named-entity\"},/&#x?[\\da-f]{1,8};/i]},Prism.languages.markup.tag.inside[\"attr-value\"].inside.entity=Prism.languages.markup.entity,Prism.languages.markup.doctype.inside[\"internal-subset\"].inside=Prism.languages.markup,Prism.hooks.add(\"wrap\",(function(a){\"entity\"===a.type&&(a.attributes.title=a.content.replace(/&amp;/,\"&\"))})),Object.defineProperty(Prism.languages.markup.tag,\"addInlined\",{value:function(a,e){var s={};s[\"language-\"+e]={pattern:/(^<!\\[CDATA\\[)[\\s\\S]+?(?=\\]\\]>$)/i,lookbehind:!0,inside:Prism.languages[e]},s.cdata=/^<!\\[CDATA\\[|\\]\\]>$/i;var t={\"included-cdata\":{pattern:/<!\\[CDATA\\[[\\s\\S]*?\\]\\]>/i,inside:s}};t[\"language-\"+e]={pattern:/[\\s\\S]+/,inside:Prism.languages[e]};var n={};n[a]={pattern:RegExp(\"(<__[^>]*>)(?:<!\\\\[CDATA\\\\[(?:[^\\\\]]|\\\\](?!\\\\]>))*\\\\]\\\\]>|(?!<!\\\\[CDATA\\\\[)[^])*?(?=</__>)\".replace(/__/g,(function(){return a})),\"i\"),lookbehind:!0,greedy:!0,inside:t},Prism.languages.insertBefore(\"markup\",\"cdata\",n)}}),Object.defineProperty(Prism.languages.markup.tag,\"addAttribute\",{value:function(a,e){Prism.languages.markup.tag.inside[\"special-attr\"].push({pattern:RegExp(\"(^|[\\\"'\\\\s])(?:\"+a+\")\\\\s*=\\\\s*(?:\\\"[^\\\"]*\\\"|'[^']*'|[^\\\\s'\\\">=]+(?=[\\\\s>]))\",\"i\"),lookbehind:!0,inside:{\"attr-name\":/^[^\\s=]+/,\"attr-value\":{pattern:/=[\\s\\S]+/,inside:{value:{pattern:/(^=\\s*([\"']|(?![\"'])))\\S[\\s\\S]*(?=\\2$)/,lookbehind:!0,alias:[e,\"language-\"+e],inside:Prism.languages[e]},punctuation:[{pattern:/^=/,alias:\"attr-equals\"},/\"|'/]}}}})}}),Prism.languages.html=Prism.languages.markup,Prism.languages.mathml=Prism.languages.markup,Prism.languages.svg=Prism.languages.markup,Prism.languages.xml=Prism.languages.extend(\"markup\",{}),Prism.languages.ssml=Prism.languages.xml,Prism.languages.atom=Prism.languages.xml,Prism.languages.rss=Prism.languages.xml;\n!function(s){var e=/(?:\"(?:\\\\(?:\\r\\n|[\\s\\S])|[^\"\\\\\\r\\n])*\"|'(?:\\\\(?:\\r\\n|[\\s\\S])|[^'\\\\\\r\\n])*')/;s.languages.css={comment:/\\/\\*[\\s\\S]*?\\*\\//,atrule:{pattern:RegExp(\"@[\\\\w-](?:[^;{\\\\s\\\"']|\\\\s+(?!\\\\s)|\"+e.source+\")*?(?:;|(?=\\\\s*\\\\{))\"),inside:{rule:/^@[\\w-]+/,\"selector-function-argument\":{pattern:/(\\bselector\\s*\\(\\s*(?![\\s)]))(?:[^()\\s]|\\s+(?![\\s)])|\\((?:[^()]|\\([^()]*\\))*\\))+(?=\\s*\\))/,lookbehind:!0,alias:\"selector\"},keyword:{pattern:/(^|[^\\w-])(?:and|not|only|or)(?![\\w-])/,lookbehind:!0}}},url:{pattern:RegExp(\"\\\\burl\\\\((?:\"+e.source+\"|(?:[^\\\\\\\\\\r\\n()\\\"']|\\\\\\\\[^])*)\\\\)\",\"i\"),greedy:!0,inside:{function:/^url/i,punctuation:/^\\(|\\)$/,string:{pattern:RegExp(\"^\"+e.source+\"$\"),alias:\"url\"}}},selector:{pattern:RegExp(\"(^|[{}\\\\s])[^{}\\\\s](?:[^{};\\\"'\\\\s]|\\\\s+(?![\\\\s{])|\"+e.source+\")*(?=\\\\s*\\\\{)\"),lookbehind:!0},string:{pattern:e,greedy:!0},property:{pattern:/(^|[^-\\w\\xA0-\\uFFFF])(?!\\s)[-_a-z\\xA0-\\uFFFF](?:(?!\\s)[-\\w\\xA0-\\uFFFF])*(?=\\s*:)/i,lookbehind:!0},important:/!important\\b/i,function:{pattern:/(^|[^-a-z0-9])[-a-z0-9]+(?=\\()/i,lookbehind:!0},punctuation:/[(){};:,]/},s.languages.css.atrule.inside.rest=s.languages.css;var t=s.languages.markup;t&&(t.tag.addInlined(\"style\",\"css\"),t.tag.addAttribute(\"style\",\"css\"))}(Prism);\nPrism.languages.clike={comment:[{pattern:/(^|[^\\\\])\\/\\*[\\s\\S]*?(?:\\*\\/|$)/,lookbehind:!0,greedy:!0},{pattern:/(^|[^\\\\:])\\/\\/.*/,lookbehind:!0,greedy:!0}],string:{pattern:/([\"'])(?:\\\\(?:\\r\\n|[\\s\\S])|(?!\\1)[^\\\\\\r\\n])*\\1/,greedy:!0},\"class-name\":{pattern:/(\\b(?:class|extends|implements|instanceof|interface|new|trait)\\s+|\\bcatch\\s+\\()[\\w.\\\\]+/i,lookbehind:!0,inside:{punctuation:/[.\\\\]/}},keyword:/\\b(?:break|catch|continue|do|else|finally|for|function|if|in|instanceof|new|null|return|throw|try|while)\\b/,boolean:/\\b(?:false|true)\\b/,function:/\\b\\w+(?=\\()/,number:/\\b0x[\\da-f]+\\b|(?:\\b\\d+(?:\\.\\d*)?|\\B\\.\\d+)(?:e[+-]?\\d+)?/i,operator:/[<>]=?|[!=]=?=?|--?|\\+\\+?|&&?|\\|\\|?|[?*/~^%]/,punctuation:/[{}[\\];(),.:]/};\nPrism.languages.javascript=Prism.languages.extend(\"clike\",{\"class-name\":[Prism.languages.clike[\"class-name\"],{pattern:/(^|[^$\\w\\xA0-\\uFFFF])(?!\\s)[_$A-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*(?=\\.(?:constructor|prototype))/,lookbehind:!0}],keyword:[{pattern:/((?:^|\\})\\s*)catch\\b/,lookbehind:!0},{pattern:/(^|[^.]|\\.\\.\\.\\s*)\\b(?:as|assert(?=\\s*\\{)|async(?=\\s*(?:function\\b|\\(|[$\\w\\xA0-\\uFFFF]|$))|await|break|case|class|const|continue|debugger|default|delete|do|else|enum|export|extends|finally(?=\\s*(?:\\{|$))|for|from(?=\\s*(?:['\"]|$))|function|(?:get|set)(?=\\s*(?:[#\\[$\\w\\xA0-\\uFFFF]|$))|if|implements|import|in|instanceof|interface|let|new|null|of|package|private|protected|public|return|static|super|switch|this|throw|try|typeof|undefined|var|void|while|with|yield)\\b/,lookbehind:!0}],function:/#?(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*(?=\\s*(?:\\.\\s*(?:apply|bind|call)\\s*)?\\()/,number:{pattern:RegExp(\"(^|[^\\\\w$])(?:NaN|Infinity|0[bB][01]+(?:_[01]+)*n?|0[oO][0-7]+(?:_[0-7]+)*n?|0[xX][\\\\dA-Fa-f]+(?:_[\\\\dA-Fa-f]+)*n?|\\\\d+(?:_\\\\d+)*n|(?:\\\\d+(?:_\\\\d+)*(?:\\\\.(?:\\\\d+(?:_\\\\d+)*)?)?|\\\\.\\\\d+(?:_\\\\d+)*)(?:[Ee][+-]?\\\\d+(?:_\\\\d+)*)?)(?![\\\\w$])\"),lookbehind:!0},operator:/--|\\+\\+|\\*\\*=?|=>|&&=?|\\|\\|=?|[!=]==|<<=?|>>>?=?|[-+*/%&|^!=<>]=?|\\.{3}|\\?\\?=?|\\?\\.?|[~:]/}),Prism.languages.javascript[\"class-name\"][0].pattern=/(\\b(?:class|extends|implements|instanceof|interface|new)\\s+)[\\w.\\\\]+/,Prism.languages.insertBefore(\"javascript\",\"keyword\",{regex:{pattern:RegExp(\"((?:^|[^$\\\\w\\\\xA0-\\\\uFFFF.\\\"'\\\\])\\\\s]|\\\\b(?:return|yield))\\\\s*)/(?:(?:\\\\[(?:[^\\\\]\\\\\\\\\\r\\n]|\\\\\\\\.)*\\\\]|\\\\\\\\.|[^/\\\\\\\\\\\\[\\r\\n])+/[dgimyus]{0,7}|(?:\\\\[(?:[^[\\\\]\\\\\\\\\\r\\n]|\\\\\\\\.|\\\\[(?:[^[\\\\]\\\\\\\\\\r\\n]|\\\\\\\\.|\\\\[(?:[^[\\\\]\\\\\\\\\\r\\n]|\\\\\\\\.)*\\\\])*\\\\])*\\\\]|\\\\\\\\.|[^/\\\\\\\\\\\\[\\r\\n])+/[dgimyus]{0,7}v[dgimyus]{0,7})(?=(?:\\\\s|/\\\\*(?:[^*]|\\\\*(?!/))*\\\\*/)*(?:$|[\\r\\n,.;:})\\\\]]|//))\"),lookbehind:!0,greedy:!0,inside:{\"regex-source\":{pattern:/^(\\/)[\\s\\S]+(?=\\/[a-z]*$)/,lookbehind:!0,alias:\"language-regex\",inside:Prism.languages.regex},\"regex-delimiter\":/^\\/|\\/$/,\"regex-flags\":/^[a-z]+$/}},\"function-variable\":{pattern:/#?(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*(?=\\s*[=:]\\s*(?:async\\s*)?(?:\\bfunction\\b|(?:\\((?:[^()]|\\([^()]*\\))*\\)|(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*)\\s*=>))/,alias:\"function\"},parameter:[{pattern:/(function(?:\\s+(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*)?\\s*\\(\\s*)(?!\\s)(?:[^()\\s]|\\s+(?![\\s)])|\\([^()]*\\))+(?=\\s*\\))/,lookbehind:!0,inside:Prism.languages.javascript},{pattern:/(^|[^$\\w\\xA0-\\uFFFF])(?!\\s)[_$a-z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*(?=\\s*=>)/i,lookbehind:!0,inside:Prism.languages.javascript},{pattern:/(\\(\\s*)(?!\\s)(?:[^()\\s]|\\s+(?![\\s)])|\\([^()]*\\))+(?=\\s*\\)\\s*=>)/,lookbehind:!0,inside:Prism.languages.javascript},{pattern:/((?:\\b|\\s|^)(?!(?:as|async|await|break|case|catch|class|const|continue|debugger|default|delete|do|else|enum|export|extends|finally|for|from|function|get|if|implements|import|in|instanceof|interface|let|new|null|of|package|private|protected|public|return|set|static|super|switch|this|throw|try|typeof|undefined|var|void|while|with|yield)(?![$\\w\\xA0-\\uFFFF]))(?:(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*\\s*)\\(\\s*|\\]\\s*\\(\\s*)(?!\\s)(?:[^()\\s]|\\s+(?![\\s)])|\\([^()]*\\))+(?=\\s*\\)\\s*\\{)/,lookbehind:!0,inside:Prism.languages.javascript}],constant:/\\b[A-Z](?:[A-Z_]|\\dx?)*\\b/}),Prism.languages.insertBefore(\"javascript\",\"string\",{hashbang:{pattern:/^#!.*/,greedy:!0,alias:\"comment\"},\"template-string\":{pattern:/`(?:\\\\[\\s\\S]|\\$\\{(?:[^{}]|\\{(?:[^{}]|\\{[^}]*\\})*\\})+\\}|(?!\\$\\{)[^\\\\`])*`/,greedy:!0,inside:{\"template-punctuation\":{pattern:/^`|`$/,alias:\"string\"},interpolation:{pattern:/((?:^|[^\\\\])(?:\\\\{2})*)\\$\\{(?:[^{}]|\\{(?:[^{}]|\\{[^}]*\\})*\\})+\\}/,lookbehind:!0,inside:{\"interpolation-punctuation\":{pattern:/^\\$\\{|\\}$/,alias:\"punctuation\"},rest:Prism.languages.javascript}},string:/[\\s\\S]+/}},\"string-property\":{pattern:/((?:^|[,{])[ \\t]*)([\"'])(?:\\\\(?:\\r\\n|[\\s\\S])|(?!\\2)[^\\\\\\r\\n])*\\2(?=\\s*:)/m,lookbehind:!0,greedy:!0,alias:\"property\"}}),Prism.languages.insertBefore(\"javascript\",\"operator\",{\"literal-property\":{pattern:/((?:^|[,{])[ \\t]*)(?!\\s)[_$a-zA-Z\\xA0-\\uFFFF](?:(?!\\s)[$\\w\\xA0-\\uFFFF])*(?=\\s*:)/m,lookbehind:!0,alias:\"property\"}}),Prism.languages.markup&&(Prism.languages.markup.tag.addInlined(\"script\",\"javascript\"),Prism.languages.markup.tag.addAttribute(\"on(?:abort|blur|change|click|composition(?:end|start|update)|dblclick|error|focus(?:in|out)?|key(?:down|up)|load|mouse(?:down|enter|leave|move|out|over|up)|reset|resize|scroll|select|slotchange|submit|unload|wheel)\",\"javascript\")),Prism.languages.js=Prism.languages.javascript;\nPrism.languages.haskell={comment:{pattern:/(^|[^-!#$%*+=?&@|~.:<>^\\\\\\/])(?:--(?:(?=.)[^-!#$%*+=?&@|~.:<>^\\\\\\/].*|$)|\\{-[\\s\\S]*?-\\})/m,lookbehind:!0},char:{pattern:/'(?:[^\\\\']|\\\\(?:[abfnrtv\\\\\"'&]|\\^[A-Z@[\\]^_]|ACK|BEL|BS|CAN|CR|DC1|DC2|DC3|DC4|DEL|DLE|EM|ENQ|EOT|ESC|ETB|ETX|FF|FS|GS|HT|LF|NAK|NUL|RS|SI|SO|SOH|SP|STX|SUB|SYN|US|VT|\\d+|o[0-7]+|x[0-9a-fA-F]+))'/,alias:\"string\"},string:{pattern:/\"(?:[^\\\\\"]|\\\\(?:\\S|\\s+\\\\))*\"/,greedy:!0},keyword:/\\b(?:case|class|data|deriving|do|else|if|in|infixl|infixr|instance|let|module|newtype|of|primitive|then|type|where)\\b/,\"import-statement\":{pattern:/(^[\\t ]*)import\\s+(?:qualified\\s+)?(?:[A-Z][\\w']*)(?:\\.[A-Z][\\w']*)*(?:\\s+as\\s+(?:[A-Z][\\w']*)(?:\\.[A-Z][\\w']*)*)?(?:\\s+hiding\\b)?/m,lookbehind:!0,inside:{keyword:/\\b(?:as|hiding|import|qualified)\\b/,punctuation:/\\./}},builtin:/\\b(?:abs|acos|acosh|all|and|any|appendFile|approxRational|asTypeOf|asin|asinh|atan|atan2|atanh|basicIORun|break|catch|ceiling|chr|compare|concat|concatMap|const|cos|cosh|curry|cycle|decodeFloat|denominator|digitToInt|div|divMod|drop|dropWhile|either|elem|encodeFloat|enumFrom|enumFromThen|enumFromThenTo|enumFromTo|error|even|exp|exponent|fail|filter|flip|floatDigits|floatRadix|floatRange|floor|fmap|foldl|foldl1|foldr|foldr1|fromDouble|fromEnum|fromInt|fromInteger|fromIntegral|fromRational|fst|gcd|getChar|getContents|getLine|group|head|id|inRange|index|init|intToDigit|interact|ioError|isAlpha|isAlphaNum|isAscii|isControl|isDenormalized|isDigit|isHexDigit|isIEEE|isInfinite|isLower|isNaN|isNegativeZero|isOctDigit|isPrint|isSpace|isUpper|iterate|last|lcm|length|lex|lexDigits|lexLitChar|lines|log|logBase|lookup|map|mapM|mapM_|max|maxBound|maximum|maybe|min|minBound|minimum|mod|negate|not|notElem|null|numerator|odd|or|ord|otherwise|pack|pi|pred|primExitWith|print|product|properFraction|putChar|putStr|putStrLn|quot|quotRem|range|rangeSize|read|readDec|readFile|readFloat|readHex|readIO|readInt|readList|readLitChar|readLn|readOct|readParen|readSigned|reads|readsPrec|realToFrac|recip|rem|repeat|replicate|return|reverse|round|scaleFloat|scanl|scanl1|scanr|scanr1|seq|sequence|sequence_|show|showChar|showInt|showList|showLitChar|showParen|showSigned|showString|shows|showsPrec|significand|signum|sin|sinh|snd|sort|span|splitAt|sqrt|subtract|succ|sum|tail|take|takeWhile|tan|tanh|threadToIOResult|toEnum|toInt|toInteger|toLower|toRational|toUpper|truncate|uncurry|undefined|unlines|until|unwords|unzip|unzip3|userError|words|writeFile|zip|zip3|zipWith|zipWith3)\\b/,number:/\\b(?:\\d+(?:\\.\\d+)?(?:e[+-]?\\d+)?|0o[0-7]+|0x[0-9a-f]+)\\b/i,operator:[{pattern:/`(?:[A-Z][\\w']*\\.)*[_a-z][\\w']*`/,greedy:!0},{pattern:/(\\s)\\.(?=\\s)/,lookbehind:!0},/[-!#$%*+=?&@|~:<>^\\\\\\/][-!#$%*+=?&@|~.:<>^\\\\\\/]*|\\.[-!#$%*+=?&@|~.:<>^\\\\\\/]+/],hvariable:{pattern:/\\b(?:[A-Z][\\w']*\\.)*[_a-z][\\w']*/,inside:{punctuation:/\\./}},constant:{pattern:/\\b(?:[A-Z][\\w']*\\.)*[A-Z][\\w']*/,inside:{punctuation:/\\./}},punctuation:/[{}[\\];(),.:]/},Prism.languages.hs=Prism.languages.haskell;\n"
  },
  {
    "path": "demo/static/test.js",
    "content": "console.log('test.js')\n\n\nwindow.addEventListener('load', function() {\n\n  let other = Hyperbole.hyperView(\"Other\")\n  document.addEventListener(\"hello\", function(e) {\n    console.log(\"got event\", e.type, e.detail, e)\n    other.runAction(\"Sneaky\")\n  })\n})\n"
  },
  {
    "path": "demo/static/todomvc.css",
    "content": "/* Undo the CSS reset for the TODOMVC example. This is only needed for the examples, because\n * we need to apply the reset for everything *except TodoMVC CSS-only. In a real app, if you \n * do not want to use atomic-css, simply omit the reset from your document function.\n *\n * In practice, you usually want a css reset anyway, even if you aren't using Atomic CSS\n * */\np {\n  margin: 1em auto;\n}\n\nfooter {\n  padding-bottom: 30px !important;\n}\n\na {\n  color: #b83f45 !important;\n}\n\nh1 {\n  top: -80px !important;\n}\n\n/* Changes to accomodate slightly different DOM generated by Hyperbole */\n.todo-list li {\n  border-bottom: 1px solid #ededed !important;\n}\n\n.todo-list div:last-child li {\n  border-bottom: none !important;\n}\n"
  },
  {
    "path": "docs/Main.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Main where\n\nimport Control.Exception (SomeException, try)\nimport Data.Char (isAlpha, isSpace)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Data.Text.IO qualified as T\nimport Distribution.Simple.Utils (copyDirectoryRecursive)\nimport Distribution.Verbosity (verbose)\nimport System.Directory\nimport System.FilePath\nimport Web.Hyperbole.Data.URI\n-- import Control.Applicative ((<|>))\n-- import Web.Hyperbole.Route (matchRoute)\n\n\nmain :: IO ()\nmain = do\n  let tmpDir = \"/tmp/hyperbole\"\n  copyExtraFilesTo tmpDir\n  expandSourcesTo tmpDir\n  putStrLn $ \"COPY RECURSIVE: \" <> (tmpDir <> \"docs\")\n  copyDirectoryRecursive verbose \"./docs\" (tmpDir </> \"docs\")\n  copyDirectoryRecursive verbose \"./demo\" (tmpDir </> \"demo\")\n\n\ntest :: IO ()\ntest = do\n  src <- readSource \"./src/Web/Hyperbole.hs\"\n  SourceCode lns <- expandFile src\n  mapM_ print lns\n\n\nexpandSourcesTo :: FilePath -> IO ()\nexpandSourcesTo tmpDir = do\n  allFiles <- relativeSourceFiles \"./src\"\n  -- mapM_ (putStrLn . (\"SOURCE \" <>)) allFiles\n  mapM_ (expandAndCopyFileTo tmpDir) allFiles\n\n\ncopyExtraFilesTo :: FilePath -> IO ()\ncopyExtraFilesTo tmpDir = do\n  createDirectoryIfMissing True tmpDir\n  copyFile \"./cabal.project\" (tmpDir </> \"cabal.project\")\n  copyFile \"./hyperbole.cabal\" (tmpDir </> \"hyperbole.cabal\")\n  copyFile \"./README.md\" (tmpDir </> \"README.md\")\n  copyFile \"./CHANGELOG.md\" (tmpDir </> \"CHANGELOG.md\")\n  copyFile \"./LICENSE\" (tmpDir </> \"LICENSE\")\n  createDirectoryIfMissing True (tmpDir </> \"client/dist\")\n  copyFile \"./client/dist/hyperbole.js\" (tmpDir </> \"client/dist/hyperbole.js\")\n  copyFile \"./client/dist/hyperbole.js.map\" (tmpDir </> \"client/dist/hyperbole.js.map\")\n  createDirectoryIfMissing True (tmpDir </> \"client/util\")\n  copyFile \"./client/util/live-reload.js\" (tmpDir </> \"client/util/live-reload.js\")\n\n\nexpandAndCopyFileTo :: FilePath -> FilePath -> IO ()\nexpandAndCopyFileTo tmpDir pth = do\n  putStrLn $ \"EXPANDING \" <> pth\n  src <- readSource pth\n  expanded <- expandFile src\n  writeSource tmpDir pth expanded\n\n\nreadSource :: FilePath -> IO SourceCode\nreadSource pth = do\n  inp <- T.readFile pth\n  pure $ SourceCode $ T.lines inp\n\n\nwriteSource :: FilePath -> FilePath -> SourceCode -> IO ()\nwriteSource tmpDir relPath src = do\n  let pth = tmpDir </> cleanRelativeDir relPath\n  -- putStrLn $ \"WRITE \" <> pth <> \" \" <> show (length src.lines)\n  createDirectoryIfMissing True $ takeDirectory pth\n  T.writeFile pth $ T.unlines src.lines\n where\n  cleanRelativeDir =\n    dropWhile (== '/') . dropWhile (== '.')\n\n\nrelativeSourceFiles :: FilePath -> IO [FilePath]\nrelativeSourceFiles dir = do\n  contents <- tryDirectory dir\n  let folders = filter isFolder contents\n  let files = filter isSourceFile contents\n\n  files' <- mapM (relativeSourceFiles . addDir) folders\n\n  pure $ fmap addDir files <> mconcat files'\n where\n  isSourceFile pth = takeExtension pth == \".hs\"\n  isFolder pth = takeExtension pth == \"\"\n  addDir = (dir </>)\n  tryDirectory pth = do\n    res <- try $ listDirectory pth\n    case res of\n      Left (_ :: SomeException) -> do\n        putStrLn $ \"SKIPPED\" <> pth\n        pure []\n      Right files -> pure files\n\n\ndata Macro\n  = Embed\n      { moduleName :: ModuleName\n      , definition :: TopLevelDefinition\n      }\n  -- | Example Path\n  deriving (Eq)\nnewtype SourceCode = SourceCode {lines :: [Text]}\ninstance Show Macro where\n  -- show (Example p) = \"Example \" <> show p\n  show (Embed mn def) = \"Embed \" <> show mn <> \" \" <> show def\n\n\nnewtype ModuleName = ModuleName Text\n  deriving newtype (Eq, Show)\n\n\nnewtype TopLevelDefinition = TopLevelDefinition Text\n  deriving newtype (Show, Eq)\n\n\nexpandFile :: SourceCode -> IO SourceCode\nexpandFile (SourceCode lns) =\n  SourceCode . mconcat <$> mapM expandLine lns\n\n\n-- > EMBED Example/Docs/BasicPage.hs page\nexpandLine :: Text -> IO [Text]\nexpandLine line = do\n  case parseMacro line of\n    Nothing -> do\n      pure [line]\n    Just (pre, Embed src def) -> do\n      expandEmbed src pre def\n where\n  -- Just (pre, Example src) -> do\n  --   expandExample src pre\n\n  parseMacro :: Text -> Maybe (Text, Macro)\n  parseMacro inp = do\n    parseEmbed inp -- <|> parseExample inp\n\n  -- parseExample l = do\n  --   case T.splitOn \"#EXAMPLE \" l of\n  --     [prefix, src] -> do\n  --       pure (prefix, Example $ path src)\n  --     _ -> Nothing\n\n  parseEmbed l = do\n    case T.splitOn \"#EMBED \" l of\n      [prefix, info] -> do\n        (mn, definition) <- splitSrcDef $ T.dropWhile (== ' ') info\n        pure (prefix, Embed mn definition)\n      _ -> Nothing\n\n  splitSrcDef inp =\n    let (mn, def) = T.breakOn \" \" inp\n     in pure (ModuleName mn, TopLevelDefinition $ T.drop 1 def)\n\n\n-- look it up as a URI...\n\n-- * #EXAMPLE /simple\n\n\n-- expandExample :: Path -> Text -> IO [Text]\n-- expandExample p prefix = do\n--   let pre = if T.null prefix then \"▶️ \" else prefix\n--   r <- appRoute\n--   pure [pre <> \"[\" <> routeTitle r <> \"](\" <> uriToText (exampleBaseURI ./. p) <> \")\"]\n--  where\n--   appRoute :: IO AppRoute\n--   appRoute = do\n--     case matchRoute @AppRoute p of\n--       Nothing -> fail $ \"Could not find example: \" <> cs (pathToText False p)\n--       Just r -> pure r\n\nexampleBaseURI :: URI\nexampleBaseURI = [uri|https://hyperbole.live|]\n\n\nmodulePath :: ModuleName -> FilePath\nmodulePath (ModuleName mn) = cs $ T.replace \".\" \"/\" mn <> \".hs\"\n\n\nexpandEmbed :: ModuleName -> Text -> TopLevelDefinition -> IO [Text]\nexpandEmbed mn pfx def = do\n  let src = modulePath mn\n  putStrLn $ \"  embed: \" <> src\n  source <- T.readFile $ \"./demo/\" <> src\n  expanded <- requireTopLevel def (SourceCode $ T.lines source)\n  pure $ fmap markupLine expanded\n where\n  requireTopLevel :: TopLevelDefinition -> SourceCode -> IO [Text]\n  requireTopLevel tld sc =\n    case findTopLevel tld sc of\n      [] -> fail $ \"Could not find: \" <> show (Embed mn def) <> \" \" <> show def\n      lns -> pure lns\n\n  -- addPrefix line = embed.prefix <> line\n  markupLine :: Text -> Text\n  markupLine line =\n    case pfx of\n      \"\" -> markupLineAt line\n      _ -> markupLinePrefix line\n  markupLineAt =\n    T.replace \"\\\"\" \"\\\\\\\"\" . highlightTermsLine\n  markupLinePrefix line =\n    pfx <> line\n\n\nhighlightTermsLine :: Text -> Text\nhighlightTermsLine ln = mconcat $ fmap highlightWord $ T.groupBy isSameTerm ln\n where\n  isSameTerm :: Char -> Char -> Bool\n  isSameTerm c1 c2 =\n    (isAlpha c1 && isAlpha c2)\n      || (isSpace c1 && isSpace c2)\n\n  highlightWord :: Text -> Text\n  highlightWord w =\n    if w `elem` terms\n      then \"'\" <> w <> \"'\"\n      else w\n\n  terms :: [Text]\n  terms =\n    [ \"HyperView\"\n    , \"View\"\n    , \"Action\"\n    , \"update\"\n    , \"hyper\"\n    , \"Page\"\n    , \"liveApp\"\n    , \"quickStartDocument\"\n    , \"runPage\"\n    , \"run\"\n    , \"ViewId\"\n    , \"viewId\"\n    , \"ViewAction\"\n    , \"Eff\"\n    , \"button\"\n    , \"el\"\n    , \"el_\"\n    , \"Hyperbole\"\n    , \"Route\"\n    , \"routeRequest\"\n    , \"route\"\n    , \"layout\"\n    , \"Response\"\n    , \"ToParam\"\n    , \"FromParam\"\n    , \"Session\"\n    , \"FromQuery\"\n    , \"ToQuery\"\n    , \"lookupParam\"\n    , \"setParam\"\n    , \"DefaultParam\"\n    , \"Client\"\n    ]\n\n\n-- returns lines of a top-level definition\nfindTopLevel :: TopLevelDefinition -> SourceCode -> [Text]\nfindTopLevel (TopLevelDefinition definition) source =\n  let rest = dropWhile (not . isTopLevel) source.lines\n   in dropWhileEnd isEmpty $ takeWhile isCurrentDefinition rest\n where\n  isTopLevel = T.isPrefixOf definition\n  isEmpty = T.null\n  -- isBlankLine line = T.null $ T.strip line\n  isCurrentDefinition line =\n    isTopLevel line || not (isFullyOutdented line)\n  dropWhileEnd p as =\n    reverse $ dropWhile p $ reverse as\n\n\nisFullyOutdented :: Text -> Bool\nisFullyOutdented line =\n  case cs (T.take 1 line) of\n    \"\" -> False\n    [c] -> not $ isSpace c\n    _ -> False\n"
  },
  {
    "path": "docs/app-document.md",
    "content": "The first argument is a `document` function. This turns an initial page fragment into a full document, complete with `<script>` and `<link>` tags.\n\nThe `quickStartDocument` adds some required CSS and Javascript, including live reload. But you can customize it however you wish. For example, here's how you might set your own title and add some global css\n\n    #EMBED Example.Document documentHead\n\n    #EMBED Example.Document main\n"
  },
  {
    "path": "docs/app-effects.md",
    "content": "Your application will want to support various side effects. It's helpful to create a single function that runs all shared effects:\n\n    #EMBED Example.Docs.App runApp\n\nAdd all your effects by calling your runner:\n\n    #EMBED Example.Docs.App app'\n\nA few pages might use effects that the rest don't need, or a specific implementation. You can choose to run an effect for a single page\n\n    #EMBED Example.Docs.App router'\n\n"
  },
  {
    "path": "docs/app-live.md",
    "content": "In [[/basics]] we showed how to run a simple application:\n\n    #EMBED Example.Docs.BasicPage main\n\n Let's go over the arguments of `liveApp`, starting with the `Document` function\n\n    liveApp\n      :: (BL.ByteString -> BL.ByteString)\n      -> Eff '[Hyperbole, Concurrent, IOE] Response\n      -> Wai.Application\n    liveApp = _\n"
  },
  {
    "path": "docs/app-pages.md",
    "content": "The second argument of `liveApp` is an `Effect` monad which returns a `Response`. We will rarely return a `Response` directly, so we use the `runPage` function to turn `Page es '[...]` into an `Eff es Response`\n\nThe idea is that an application is divided into _independent_ `Page`s, which completely reload when you navigate between them. This is a deliberate choice to simplify development. In Single Page Applications, internal navigation often causes all sorts of strange state synchronization issues.\n\nWe suggest you create a module for each `Page`, each with its own `page` function\n\n    #EMBED Example.Docs.MultiView page\n"
  },
  {
    "path": "docs/app-routes.md",
    "content": "Since we have more than one `Page`, we need a way to choose between them. You could create a manual function `Hyperbole :> es => Eff es Response` which reads the `Request`, and `runPage` different `Pages` depending on the `Path`, but Hyperbole comes with support for type-safe `Route`s:\n\n    #EMBED Example.Docs.App data AppRoute\n\n    #EMBED Example.Docs.App instance Route\n\n```\n>>> routeUri Main\n\"/\"\n\n>>> routeUri (User 3)\n\"/user/3\"\n```\n\n\nThen, as the second argument to `liveApp`, you can pattern match on the `Route` to run various `Page`s using `routeRequest`. If your route has data in it, you can pass it to the corresponding page\n\n    #EMBED Example.Docs.App router\n\n    #EMBED Example.Docs.App app\n"
  },
  {
    "path": "docs/atomic.md",
    "content": "Hyperbole encourages using the [atomic-css](https://github.com/seanhess/atomic-css)  package to factor styles with haskell functions. Here is how we might create reusable header and btn styles:\n\n    #EMBED Example.Docs.CSS import\n\n    #EMBED Example.Docs.CSS example\n\nNote how we use `hover` to provide immediate feedback to the user without talking to the server\n"
  },
  {
    "path": "docs/comparison.md",
    "content": "Comparison with Similar Frameworks\n==================================\n\n[HTMX](https://htmx.org/)\n----------------\n\nSimilarities\n\n* Updates return new views\n\nDifferences\n\n* Typed HyperViews provide structure to a page\n* Actions and updates grouped together by HyperView\n* Limited swap options and other advanced features in the name of preserving developer sanity\n\n\n[Elm](https://elm-lang.org/)\n---------------------------\n\nSimilarities\n\n* ADTs of Actions with corresponding updates\n* Encourages using view functions\n\nDifferences\n\n* Runs serverside\n* Greatly simplifies the Elm Architecture by removing state. Updates directly return views\n* Simpler forms\n* Side effects are handled by [Effectful](https://hackage.haskell.org/package/effectful)\n* Page and nested view hierarchy are more intuitive and require less boilerplate\n\n\n[Phoenix LiveView](https://www.phoenixframework.org/)\n------------------------------------------------------\n\nSimilarities\n\n* Upgrades the page to a fast WebSocket connection\n* Patches the page in-place using VDOM\n* Client-side events\n"
  },
  {
    "path": "docs/concurrency-overlap.md",
    "content": "By default, if an `Action` triggers for a particular `HyperView` when one is already being processed, the system will `Drop` the newer action without running it. This prevents destructive actions from accidentally happening more than once.\n\nHowever, some user inputs only load data and overlap many times, such as an autocomplete or mouse events. In these cases, it can be better set the `Concurrency` of the `HyperView` to `Replace`. This will cancel the currently running action, and immediately run the new one instead.\n\n    #EMBED Example.Concurrency.Overlap instance (Debug :> es) => HyperView OverlapReplace\n\nSee [[/data/autocomplete]] for a complete example\n"
  },
  {
    "path": "docs/dev.md",
    "content": "Local Development\n=================\n\nDownload and install [NPM](https://nodejs.org/en/download). On a mac, can be installed via homebrew:\n\n```\nbrew install npm\n```\n\nInstall client dependencies\n\n```\ncd client\nnpm install\n```\n\nRecommended: Use `direnv` to automatically load environment from .env\n\n```\nbrew install direnv\ndirenv allow\n```\n\n\n### Building\n\nBuild JavaScript client\n\n```\ncd client\nnpx webpack\n```\n\nRun examples\n\n```\n# demo needs to have demo/static and client/dist as relative paths\ncd <your-path-to>/hyperbole\ncabal run demo\n```\n\n### Tests\n\n```\ncabal test\n```\n\n### File watching\n\nRun tests, then recompile everything on file change and restart examples\n\n```\nbin/dev\n```\n"
  },
  {
    "path": "docs/docgen.cabal",
    "content": "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.com/sol/hpack\n\nname:           docgen\nversion:        0.5.0\nsynopsis:       Interactive HTML apps using type-safe serverside Haskell\ndescription:    Interactive HTML applications using type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView\ncategory:       Web, Network\nhomepage:       https://github.com/seanhess/hyperbole\nbug-reports:    https://github.com/seanhess/hyperbole/issues\nauthor:         Sean Hess\nmaintainer:     seanhess@gmail.com\nlicense:        BSD-3-Clause\nbuild-type:     Simple\n\nsource-repository head\n  type: git\n  location: https://github.com/seanhess/hyperbole\n\nexecutable docgen\n  main-is: Main.hs\n  other-modules:\n      Paths_docgen\n  autogen-modules:\n      Paths_docgen\n  hs-source-dirs:\n      ./\n  default-extensions:\n      OverloadedStrings\n      OverloadedRecordDot\n      DuplicateRecordFields\n      NoFieldSelectors\n      TypeFamilies\n      DataKinds\n      DerivingStrategies\n      DeriveAnyClass\n  ghc-options: -Wall -fdefer-typed-holes\n  build-depends:\n      Cabal\n    , base\n    , casing\n    , directory\n    , filepath\n    , hyperbole\n    , string-conversions\n    , text\n  default-language: GHC2021\n"
  },
  {
    "path": "docs/effectful.md",
    "content": "Hyperbole relies heavily on [Effectful](https://hackage.haskell.org/package/effectful) to run and compose side effects. We can use these `Effect`s in any `Page` or `update`.\n\nThe `Hyperbole` effect is automatically available in both, and gives us direct access to the client connection. We can use it to get information about the `request`, update the page directly, and more. Here is how you might use it to set the page title.\n\n    #EMBED Example.Docs.SideEffects data Titler\n \n    #EMBED Example.Docs.SideEffects instance HyperView Titler\n\nFor more information on the `Hyperbole` `Effect`, see [[/hyperboleeffect]]\n\n"
  },
  {
    "path": "docs/effects-custom.md",
    "content": "We could run a database using the `IOE` effect, but it is better to describe the high-level operations available to the application as a custom effect:\n\n    #EMBED Example.Effects.Todos data Todos\n\n    #EMBED Example.Effects.Todos loadAll\n\n\nJust like built-in effects, we add it to any `HyperView` and `Page` that needs it as a constraint.\n\n    {-# LANGUAGE UndecidableInstances #-}\n\n    #EMBED Example.Todos.Todo simplePage\n\nWe run a custom effect in our Application just like any other. The [[/examples/todos]] example implements the Todos `Effect` using `Hyperbole` `session`s, but you could write a different runner that connects to a database instead.\n\n    #EMBED Example.Todos.Todo main\n\nImplementing a database runner as a custom `Effect` is beyond the scope of this documentation, but see the following:\n\n* [Effectful.Dynamic.Dispatch](https://hackage.haskell.org/package/effectful-core/docs/Effectful-Dispatch-Dynamic.html) - Introduction to Effects\n* [NSO.Data.Datasets](https://github.com/DKISTDC/level2/blob/main/src/NSO/Data/Datasets.hs) - Production Data Effect with a database runner\n* [Effectful.Rel8](https://github.com/DKISTDC/level2/blob/main/types/src/Effectful/Rel8.hs) - Effect for the [Rel8](https://hackage.haskell.org/package/rel8) Postgres Library\n"
  },
  {
    "path": "docs/effects-other.md",
    "content": "If we want to use an `Effect` besides `Hyperbole`, add it as a constraint to any `Page` and `HyperView` that needs it\n\nThe following `HyperView` uses a `Reader` to get a message set at the application level. It also uses `Concurrent` to delay the response by 500ms:\n\n    {-# LANGUAGE UndecidableInstances #-}\n    \n    #EMBED Example.Docs.SideEffects page\n\n    #EMBED Example.Docs.SideEffects data SlowReader\n\n    #EMBED Example.Docs.SideEffects instance (Concurrent\n\nThen make sure to add the effect when you run your application\n\n    #EMBED Example.Docs.SideEffects app\n"
  },
  {
    "path": "docs/forms-simple.md",
    "content": "We can render and parse `form`s via a record. This can be a simple record:\n\n    #EMBED Example.FormSimple data ContactForm\n\nUsing a simple record requires you to match the field names manually: \n\n    #EMBED Example.FormSimple nameForm\n\nAlternatively, use a Higher-Kinded record, and use `fieldNames` to have the compiler help:\n\n    #EMBED Example.FormSimple data ContactForm'\n\n    #EMBED Example.FormSimple nameForm'\n\n"
  },
  {
    "path": "docs/forms-validated.md",
    "content": "We can use a Higher-Kinded `form` not only for field names and values, but to `validate` form fields\n\n    #EMBED Example.FormValidation data UserForm\n\nWrite a validator for each field:\n\n    #EMBED Example.FormValidation validateAge\n\nThen combine them into a record of `Validated` fields\n\n    #EMBED Example.FormValidation validateForm\n\n\n\n\n"
  },
  {
    "path": "docs/hyperviews-intro.md",
    "content": "Let's get interactive! Using `Hyperbole`, we divide our `Page` into independent live subsections called `HyperView`s\n\nTo start, define a data type that uniquely identifies an interactive section of the page. Make it an instance of `ViewId`. We will call this datatype a `ViewId`\n\n    #EMBED Example.Simple data Message\n\nNext we make the `ViewId` an instance of `HyperView`:\n\n* Create an `Action` type with a constructor for every possible way that the user can interact with it\n* Write an `update` for each `Action`\n\n```\n#EMBED Example.Simple instance HyperView Message\n```\n\nIf an `Action` occurs, the contents of our `HyperView` will be replaced with the result of `update`.\n\nChoose where the new `HyperView` will appear on the page using the `hyper` function, and add the `ViewId` type to the type-level list of `Page`\n\n    #EMBED Example.Docs.Interactive page\n\nFinally, let's create a `View` with a button that triggers our `Action`. Instead of using a generic `context` in the `View` type signature, we must set it to our `ViewId`. The compiler will tell us if we try to trigger actions that don't belong to our `HyperView` instance\n\n    #EMBED Example.Simple messageView\n\nWhen the user clicks the button, the contents of `hyper` will be replaced with the result of `update`, leaving the rest of the page untouched.\n"
  },
  {
    "path": "docs/hyperviews-multi.md",
    "content": "We can add as many `HyperView`s to a `Page` as we want. Each will update independently. These can be copies of the same `HyperView` with unique `ViewId` values, or completely different `HyperView` instances\n\nLet's add a `Counter` and two Message `HyperView`s to the same page\n\n    #EMBED Example.Docs.MultiView page\n\n"
  },
  {
    "path": "docs/hyperviews-nesting.md",
    "content": "We can nest smaller, more specific `HyperView`s inside of a larger parent. You might need this technique to display a list of items which also need to update themselves individually\n\nTo illustrate, let's enhance the previous example by creating a parent `HyperView` for the list of items, with an `Action` that can reset them\n\n    #EMBED Example.Docs.Nesting data ItemList\n\nEmbed the parent `HyperView` into the page\n\n    #EMBED Example.Docs.Nesting page\n\nAnd embed the individual Item `HyperView`s into the Item `View`\n\n    #EMBED Example.Docs.Nesting itemList\n\nAdd any nested `HyperView`s to `Require` to make sure they are handled. The compiler will let you know if you forget\n\n    #EMBED Example.Docs.Nesting instance HyperView ItemList\n"
  },
  {
    "path": "docs/hyperviews-unique.md",
    "content": "`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 differentiate them. In the example above we used two distinct constructors for Message, but we could also use a product type:\n\n    #EMBED Example.Docs.UniqueViewId data Item\n\nThis is especially useful if we put identifying information in our `ViewId`, such as a database id. When we embed an item using `hyper`, we use a unique `ViewId` generated from that id\n\n    #EMBED Example.Docs.UniqueViewId page\n\nThe `viewId` function can then give us access to said identifier in `update` or a `View`\n\n    #EMBED Example.Docs.UniqueViewId instance HyperView\n\n    #EMBED Example.Docs.UniqueViewId itemUnloaded\n\nThe `ViewId` is constant for the lifetime of the `HyperView`, so it won't work to try to cram state into it. Instead, use one of the approaches outlined in [[/state]]\n"
  },
  {
    "path": "docs/interactivity-events.md",
    "content": "Hyperbole provides various events that can be tied to specific `Action`s. Up to this point, we've only used them via the higher-level `View`s like `button` and `dropdown` . There are also events like `onClick`, `onKeyDown`, and `onInput` which can be used directly\n\n    #EMBED Example.Interactivity.Events viewEvents\n\n"
  },
  {
    "path": "docs/interactivity-events2.md",
    "content": "The following example demonstrates using `onMouseEnter` and `onMouseLeave`\n\nRemember it is better to use Atomic CSS to provide immediate feedback whenever possible. If used improperly, too many mouse events could make the app unresponsive\n\n    #EMBED Example.Interactivity.Events viewBoxes\n\nFor a more in-depth example see [[/data/autocomplete]]\n"
  },
  {
    "path": "docs/interactivity-inputs.md",
    "content": "We've seen `button` in quite a few examples. Hyperbole provides a few other high-level inputs to easily tie interactivity to an `Action`, such as `search`, `dropdown`, and `option`\n\n    #EMBED Example.Interactivity.Inputs data Planet\n\n    #EMBED Example.Interactivity.Inputs selectPlanet\n\nFor a more in-depth example see [[/data/filter]]\n\n"
  },
  {
    "path": "docs/interactivity-javascript.md",
    "content": "Include custom js on a page with the script tag on only the page where it is needed, or globally via your `docuemnt` function\n\n    #EMBED Example.Javascript page\n\n\n```\nlet boxes = Hyperbole.hyperView(\"JBoxes\")\nconsole.log(\"Found HyperView 'Boxes'\")\n\nboxes.addEventListener(\"mouseover\", function(e) {\n  if (e.target.classList.contains(\"box\")) {\n    let action = Hyperbole.action(\"Selected\", parseInt(e.target.innerHTML))\n    boxes.runAction(action)\n  }\n})\nboxes.addEventListener(\"mouseout\", function(e) {\n  if (e.target.classList.contains(\"box\")) {\n    boxes.runAction(\"Clear\")\n  }\n})\n```\n\n## RunAction\n\nJS can call the server with an API attached to `window.Hyperbole`. Here we re-implement mouseover boxes from the events example using Javascript\n"
  },
  {
    "path": "docs/interactivity-pushevent.md",
    "content": "## PushEvent\n\nThe server can push an event to be dispatched on a `HyperView`\n\n    #EMBED Example.Javascript update AlertMe\n\n```\nfunction listenServerEvents() {\n  // you can listen on document instead, the event will bubble\n  Hyperbole.hyperView(\"Message\").addEventListener(\"server-message\", function(e) {\n    alert(\"Server Message: \" + e.detail)\n  })\n}\n```\n"
  },
  {
    "path": "docs/intro-downsides.md",
    "content": "__Beginners__ - It uses some advanced Haskell features, and requires using [Effectful](https://hackage.haskell.org/package/effectful). If you are learning Haskell, I recommend using [Scotty](https://hackage.haskell.org/package/scotty) instead. While it doesn't provide any interactivity, it will be much easier to trace everything that is going on and will help you learn faster.\n\n__Offline and Low-Latency Apps__ - Some apps really do need to interact instantly using complex client-side logic. Hyperbole has a [[/javascript]] API to layer in client-side code when you need it, and one could certainly clone Gmail or Facebook. However, if your team is big enough to hire separate Javascript developers, it's time to call yourself a \"backend expert\" and write an an API using [Servant](https://hackage.haskell.org/package/servant) instead.\n"
  },
  {
    "path": "docs/intro-links.md",
    "content": "This site has detailed documentation with inline examples. Click the \"source\" link to see the real source code for the example. You'll also see some inline code references that link out to hackage\n\n* [Github](https://github.com/seanhess/hyperbole) - Issues, source code\n* [Hackage](https://hackage.haskell.org/package/hyperbole) - Reference\n\n▶️ Continue to [[/basics]]\n"
  },
  {
    "path": "docs/intro.md",
    "content": "Single Page Applications (SPAs) require the programmer to write two programs: a Javascript client and a Server, which both must conform to a common API\n\n\nHyperbole allows us to instead write a single Haskell program which runs exclusively on the server. All user interactions are sent to the server for processing, and a sub-section of the page is updated with the resulting HTML.\n\n>  Why write HTML and Javascript when you can... not do that? \n\nThere are frameworks that support this in different ways, including [HTMX](https://htmx.org/), [Phoenix LiveView](https://www.phoenixframework.org/), and others. Hyperbole has the following advantages\n\n1. 100% Haskell\n2. Type safe views, actions, routes, and forms\n3. Elegant interface with little boilerplate\n4. VirtualDOM updates over sockets\n5. Easy to use\n\n>  1000x more fun than React!\n\nLike [HTMX](https://htmx.org/), Hyperbole extends the capability of UI elements, but it uses Haskell's type-system to prevent common errors and provide default functionality. Specifically, a page has multiple update targets called `HyperView`s. These are automatically targeted by any UI element that triggers an action inside them. The compiler makes sure that actions and targets match\n\nLike [Phoenix LiveView](https://www.phoenixframework.org/), it upgrades the page to a fast WebSocket connection and uses VirtualDOM for live updates\n\nLike [Elm](https://elm-lang.org/), it uses an `update` function to process actions, but greatly simplifies the Elm Architecture by directly returning html instead of using a reducer. `ViewState` is optional. Effects are handled by [Effectful](https://hackage.haskell.org/package/effectful). `form`s are easy to use with minimal boilerplate\n\nHyperbole depends heavily on the following frameworks:\n\n* [Effectful](https://hackage.haskell.org/package/effectful)\n* [Atomic CSS](https://hackage.haskell.org/package/atomic-css)\n\n<!-- >  Accidentally learn to use extensible effects! -->\n"
  },
  {
    "path": "docs/javascript_api.md",
    "content": "Javascript API\n-----------------\n\nRequirements\n\n1. Call runAction() - you ought to be able to tell the server to run a particular action, and allow the normal update cycle to happen\n\n\n### Javascript Components\n1. data-xxxx updates\n2. trigger events to update - the server controls how to serialize this \n\n\n\nhttps://github.com/seanhess/hyperbole/issues/25\n- wants to be able to trigger an action, and run javascript during it...\n- but \n\n\n\n\nPhoenix LiveView MouseOver / MouseEnter:\n----------------------------------------\n\n    import { Socket } from \"phoenix\";\n    import { LiveSocket } from \"phoenix_live_view\";\n\n    // Register hooks here\n    let Hooks = {};\n    Hooks.HoverHook = {\n      mounted() {\n        console.log(\"Hook mounted!\");\n        this.el.addEventListener(\"mouseenter\", () => {\n          this.pushEvent(\"mouse_enter\", { id: this.el.id });\n        });\n        this.el.addEventListener(\"mouseleave\", () => {\n          this.pushEvent(\"mouse_leave\", { id: this.el.id });\n        });\n      }\n    };\n\n    // Initialize LiveSocket with hooks\n    let liveSocket = new LiveSocket(\"/live\", Socket, {\n      hooks: Hooks, // Hooks get passed here\n    });\n\n    // Connect LiveSocket\n    liveSocket.connect();\n\n\nPhoenix LiveView Push Event to Client\n--------------------------------------\n\n    def handle_event(\"firebase_login\", %{\"token\" => token}, socket) do\n      case UserAuth.verify_firebase_token(token) do\n        {:ok, user_info} ->\n          socket =\n            socket\n            |> assign(:current_user, user_info)  # Triggers re-render\n            |> push_event(\"auth_success\", %{email: user_info.email})  # Sends data to JS\n\n          {:noreply, socket}\n      end\n    end\n\n\n    Hooks.FirebaseAuth = {\n      mounted() {\n        this.handleEvent(\"auth_success\", ({ email }) => {\n          console.log(\"Authenticated as:\", email);\n          document.getElementById(\"user-info\").innerText = `Logged in as ${email}`;\n        });\n\n        this.handleEvent(\"auth_failed\", () => {\n          console.log(\"Authentication failed.\");\n          document.getElementById(\"user-info\").innerText = \"Login failed.\";\n        });\n      }\n    };\n"
  },
  {
    "path": "docs/multi-same.md",
    "content": "We can embed more than one of the same `HyperView` as long as the _value_ of `ViewId` is unique. Let's update `Message` to allow for more than one value:\n\n    #EMBED Example.Simple data Message\n\nNow we can embed multiple `Message` `HyperView`s into the same `Page`. Each will update independently\n\n    #EMBED Example.Simple page\n\n<!-- TODO CHANG EME -->\n\nThis is especially useful if we put identifying information in our `ViewId`, such as a database id. The `viewId` function can give us access to that info:\n\n    #EMBED Example.DataLists.LoadMore data Languages\n\n    #EMBED Example.DataLists.LoadMore instance HyperView Languages\n"
  },
  {
    "path": "docs/nix.md",
    "content": "Usage with NIX\n==============\n\n\nHow to Import Flake\n-------------------\n\nYou can import this flake's overlay to add `hyperbole` to all package sets and override ghc966 and ghc982 with the packages to satisfy `hyperbole`'s dependencies.\n\n```nix\n{\n  inputs = {\n    nixpkgs.url = \"github:nixos/nixpkgs/nixpkgs-unstable\";\n    hyperbole.url = \"github:seanhess/hyperbole\"; # or \"path:/path/to/cloned/hyperbole\";\n    flake-utils.url = \"github:numtide/flake-utils\";\n  };\n\n  outputs = { self, nixpkgs, hyperbole, flake-utils, ... }:\n    flake-utils.lib.eachDefaultSystem (\n      system:\n      let\n        pkgs = import nixpkgs {\n          inherit system;\n          overlays = [ hyperbole.overlays.default ];\n        };\n        haskellPackagesOverride = pkgs.overriddenHaskellPackages.ghc966.override (old: {\n          overrides = pkgs.lib.composeExtensions (old.overrides or (_: _: { })) (hfinal: hprev: {\n            # your overrides here\n          });\n        });\n      in\n      {\n        devShells.default = haskellPackagesOverride.shellFor {\n          packages = p: [ p.hyperbole ];\n        };\n      }\n    );\n}\n```\n\n\nLocal Development with NIX\n--------------------------\n\n### Recommended ghcid command\n\nIf you want to work on both the hyperbole library and example code, this `ghcid` command will run (and hot reload) the examples server as you change any non-testing code.\n\n```\nghcid --setup=Example.App.update --command=\"cabal repl exe:examples lib:hyperbole\" --run=Example.App.update --warnings --reload=./client/dist/hyperbole.js\n```\n\nIf you want to work on the test suite, this will run the tests each time any library code is changed.\n\n```\nghcid --command=\"cabal repl test lib:hyperbole\" --run=Main.main --warnings --reload=./client/dist/hyperbole.js\n```\n\n### Nix\n\n- `nix flake check` will build the library, example executable and devShell with ghc-9.8.2 and ghc-9.6.6\n    - This is what the CI on GitHub runs\n- `nix run` or `nix run .#ghc982-example` to start the example project with GHC 9.8.2\n    - `nix run .#ghc966-example` to start the example project with GHC 9.6.6\n- `nix develop` or `nix develop .#ghc982-shell` to get a shell with all dependencies installed for GHC 9.8.2. \n    - `nix develop .#ghc966-shell` to get a shell with all dependencies installed for GHC 9.6.6. \n- `nix build`, `nix build .#ghc982-hyperbole` and `nix build .#ghc966-hyperbole` builds the library with the `overriddenHaskellPackages`\n    - If you want to import this flake, use the overlay\n- `nix flake update atomic-css` will update the `atomic-css` input\n\nNote: You can always run `cachix use hyperbole` to use the GitHub CI populated cache if you didn't allow adding 'extra-substituters' when first using this flake.\n\n### Common Nix Issues\n\n#### Not Allowed to Refer to GHC\n\nIf you get an error like:\n\n```\nerror: output '/nix/store/64k8iw0ryz76qpijsnl9v87fb26v28z8-my-haskell-package-1.0.0.0' is not allowed to refer to the following paths:\n         /nix/store/5q5s4a07gaz50h04zpfbda8xjs8wrnhg-ghc-9.6.3\n```\n\nFollow these [instructions](https://nixos.org/manual/nixpkgs/unstable/#haskell-packaging-helpers)\n\n#### Dependencies Incorrect\n\nIf you need to update `atomic-css` run `nix flake update atomic-css`, otherwise:\n\nYou will need to update the overlay, look for where it says `\"${packageName}\" = hfinal.callCabal2nix packageName src { };` and add a line like `Diff = hfinal.callHackage \"Diff\" \"0.5\" { };` with the package and version you need.\n\n#### Missing Files\n\nCheck the `include` inside the `nix-filter.lib` to see if all files needed by cabal are there.\n\n\n"
  },
  {
    "path": "docs/outline.md",
    "content": "# TODO: ConcurrencyMode = Replace, etc\n# TODO: feedback - loading\n\nIntro\n------\n\n\n\n\nBasics\n------\n\n* Get Running\n* Html Views\n* HyperViews\n\n\nMore HyperViews\n--------------\n* Independent Updates\n* Unique ViewId\n* Nesting\n\n\n\nView Functions\n-------------------------\n\n* View Functions\n* Functions, Not Components\n\nStyles\n------\n\n* Atomic CSS\n* CSS Transitions\n* Tooltips\n* External Stylesheets\n\n\nSide Effects\n------------\n* Effectful\n* Reader and More\n* Databases and Custom Effects\n\n\nManaging State\n--------------\n* Stateless\n* Action Threading\n* View State\n* Browser Query\n* Browser Sessions\n* With Effects\n\nMultiple Hyperviews\n------------------\n\n\n\nNEEDS SORTING\n* Javascript\n* Interactivity (Events)\n* Forms\n* Data Lists\n* Concurrency\n\nApplication\n----------------\n* Pages and Routes\n*  Document\n\nHyperbole Effect\n----------------\n*  Requests\n*  Error Handling (Exceptions, Edge Cases, Handling in Views, Custom Error Views)\n\n\nExamples\n--------\n"
  },
  {
    "path": "docs/package.yaml",
    "content": "name:               docgen\nversion:            0.5.0\nsynopsis:           Interactive HTML apps using type-safe serverside Haskell\nhomepage:           https://github.com/seanhess/hyperbole\ngithub:             seanhess/hyperbole\nlicense:            BSD-3-Clause\nauthor:             Sean Hess\nmaintainer:         seanhess@gmail.com\ncategory:           Web, Network\ndescription:        Interactive HTML applications using type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView\n\nlanguage: GHC2021\n\nghc-options:\n  - -Wall\n  - -fdefer-typed-holes\n\ndefault-extensions:\n  - OverloadedStrings\n  - OverloadedRecordDot\n  - DuplicateRecordFields\n  - NoFieldSelectors\n  - TypeFamilies\n  - DataKinds\n  - DerivingStrategies\n  - DeriveAnyClass\n\ndependencies:\n  - base\n  - directory\n  - filepath\n  - text\n  - string-conversions\n  - Cabal\n  - hyperbole\n  - casing\n\nexecutables:\n  docgen:\n    main:                Main.hs\n    source-dirs:\n      - .\n    dependencies: []\n\n"
  },
  {
    "path": "docs/pages.md",
    "content": "\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/Docs/MultiPage.hs data AppRoute\n@\n\nWhen we create our app, we can add a router function which maps a 'Route' to a 'Page' with 'routeRequest'. The web page is completely reloaded each time you switch routes. Each 'Page' is completely isolated.\n\n@\n#EMBED Example/Docs/MultiPage.hs main\n@\n\nWe can add type-safe links to other pages using 'route'\n\n@\n#EMBED Example/Docs/MultiPage.hs menu\n@\n\nIf you need the same header or menu on all pages, use a view function:\n\n@\n#EMBED Example/Docs/MultiPage.hs layout\n\n#EMBED Example/Docs/MultiPage.hs examplePage\n@\n\nAs shown above, each 'Page' can contain multiple interactive 'HyperView's to add interactivity\n"
  },
  {
    "path": "docs/state-browser.md",
    "content": "The state `Action` threading and `ViewState` both live in on the web page itself, and are reset when the user navigates away or refreshes  the browser.\n\nUsing the `Hyperbole` effect, we can store state in the browser `Query` string. This is useful for faceted search, or any time a user might want to share a url and have the page load with local state changes.\n\n    #EMBED Example.State.Query data Preferences\n    #EMBED Example.State.Query instance Default Preferences\n\nAccess the current query (or the default) using `query`, or work directly with `param`s. Save changes using `modifyQuery`, `setQuery`, `setParam`, etc\n\nState stored in the `Query` is page-wide, and survives refreshes or as long as the url is available.\n"
  },
  {
    "path": "docs/state-effects.md",
    "content": "For any real application, most persistent state will need to use a separate `Effect`, like a database. In [[/sideeffects]] we demonstrated how to use a custom effect to wrap a database.\n\nAnother way to store application-wide state is to use the `Concurrent` effect. It gives us the ability to work with `TVar`s, `MVar`s and `STM`. Here is another counter, implemented using `Reader (TVar Int)`\n\n    #EMBED Example.State.Effects page\n\n    #EMBED Example.State.Effects getCount\n\nNotice how this state is shared among all users application-wide, and survives until the app restarts\n"
  },
  {
    "path": "docs/state-sessions.md",
    "content": "Likewise we can store state in a browser cookie using `Session`. This is useful for user preferences, login state, and any time you want client-specific state to persist across navigation and refreshes\n\n    #EMBED Example.State.Sessions data Preferences\n    #EMBED Example.State.Sessions instance Default Preferences\n\n\nAccess the current session (or the default) using `session`, or manipulate it with `saveSession`, `deleteSession`, etc\n\nState stored in the `Session` is page-specific by default, but can be configured to be application-wide. It survives until manually cleared by the user or the application. \n"
  },
  {
    "path": "docs/state-stateless.md",
    "content": "By default, `HyperView`s are stateless. Nothing is stored in the server connection. `HyperView` `update`s are the direct result of processing the `Action`.\n\n    #EMBED Example.State.Stateless instance HyperView Swapper\n"
  },
  {
    "path": "docs/state-threading.md",
    "content": "The simplest way to add state to a `HyperView` is to pass it back and forth between the `Action` and the `View`. In this implementation of the classic counter example, each constructor of the `Action` expects an `Int`, which represents the current count:\n\n    #EMBED Example.Counter instance HyperView Counter\n\nOur `View` Function also expects the current count as an input. It includes it in each `Action`, and the cycle continues:\n\n    #EMBED Example.Counter viewCount\n"
  },
  {
    "path": "docs/state-viewstate.md",
    "content": "`Hyperbole` can manage action-threaded state automatically by setting `ViewState` in your `ViewId`:\n\n    #EMBED Example.State.ViewState data Counter\n    #EMBED Example.State.ViewState instance ViewId\n\nInstead of `hyper`, use `hyperState` to embed the `HyperView` with a starting state:\n\n    #EMBED Example.State.ViewState page\n\n`State (ViewState viewId) :> es`  is already included in `update`, and can be accessed with familiar functions like `get` `put` and `modify` from [Effectful.State.Dynamic](https://hackage-content.haskell.org/package/effectful-core/docs/Effectful-State-Dynamic.html)\n\n    #EMBED Example.State.ViewState instance HyperView Counter\n\nTo read the state in `View` use the `viewState` function\n\n    #EMBED Example.State.ViewState viewCount\n"
  },
  {
    "path": "docs/view-components.md",
    "content": "You may be tempted to use `HyperView`s to create reusable \\\"_Components_\\\". This leads to object-oriented designs that don't compose well. We are using a functional language; our main unit of reuse should be functions!\n\nThe `header` view function we defined above has a generic `context` that can be used in any view. This approach is great for reusing styles or layout. But what if we want to reuse interactivity? We can pass an `Action` into the view function as a parameter:\n\n    #EMBED Example.Docs.Component styledButton\n\nWe can create more complex view functions by passing state in as a parameter. Here's a button that toggles between a checked and unchecked state for any `HyperView`:\n\n    #EMBED Example.View.Inputs toggleCheckbox\n\n    #EMBED Example.Docs.ViewFunctions toggler\n\n"
  },
  {
    "path": "docs/view-functions-end.md",
    "content": "Don't use `HyperView`s to keep your code DRY. Instead, think about which subsections of a page ought to update independently. Those are `HyperView`s. If you need reusable interactivity, use view functions whenever possible.\n\nSee [[/data/sortabletable]] for a more complicated example\n\n"
  },
  {
    "path": "docs/view-functions-wrap.md",
    "content": "View functions can be containers which wrap other Views:\n\n    #EMBED Example.View.Inputs progressBar\n\n    #EMBED Example.Docs.ViewFunctions workingHard\n"
  },
  {
    "path": "docs/view-functions.md",
    "content": "We showed in [[basics]] how we can factor `View`s into functions. It's best practice to have a main `View` function for each `HyperView`. Create views as pure functions of input data and state:\n\n    inputs -> View viewId ()\n\nWe can write multiple view functions with our `HyperView` as the `context`, and factor them however is most convenient:\n\n    #EMBED Example.Docs.ViewFunctions ^messageButton\n\nGeneric `View` functions can be used in any `context`:\n\n    #EMBED Example.Docs.ViewFunctions ^header\n\nNow that we have created multiple smaller view functions, we can refactor our main `View` function to use them and avoid repeating ourselves\n\n    #EMBED Example.Docs.ViewFunctions messageView\n\n"
  },
  {
    "path": "flake.nix",
    "content": "{\n  description = \"hyperbole overlay, development and hyperbole-demo\";\n\n  nixConfig = {\n    extra-substituters = [\n      \"https://hyperbole.cachix.org\"\n    ];\n    extra-trusted-public-keys = [\n      \"hyperbole.cachix.org-1:9Pl9dJXuJrAxGkrG8WNQ/hlO9rKt9b5IPksG7y78UGQ=\"\n    ];\n  };\n\n  inputs = {\n    pre-commit-hooks = {\n      url = \"github:cachix/pre-commit-hooks.nix\";\n      inputs.nixpkgs.follows = \"nixpkgs\";\n    };\n    nixpkgs.url = \"nixpkgs/nixos-unstable\";\n    flake-utils.url = \"github:numtide/flake-utils\";\n    nix-filter.url = \"github:numtide/nix-filter/main\";\n    atomic-css.url = \"github:seanhess/atomic-css\";\n  };\n\n  outputs =\n    {\n      self,\n      nixpkgs,\n      nix-filter,\n      flake-utils,\n      pre-commit-hooks,\n      atomic-css,\n    }:\n    let\n      packageName = \"hyperbole\";\n      demoName = \"hyperbole-demo\";\n      src = nix-filter.lib {\n        root = ./.;\n        include = [\n          \"src\"\n          \"client/dist\"\n          \"client/util/live-reload.js\"\n          \"test\"\n          ./${packageName}.cabal\n          ./cabal.project\n          ./package.yaml\n          ./fourmolu.yaml\n          ./README.md\n          ./CHANGELOG.md\n          ./LICENSE\n        ];\n      };\n\n      overlay = final: prev: {\n        overriddenHaskellPackages = {\n          ghc982 = (prev.overriddenHaskellPackages.ghc982 or prev.haskell.packages.ghc982).override (old: {\n            overrides = prev.lib.composeExtensions (old.overrides or (_: _: { })) (\n              hfinal: hprev: {\n                \"${packageName}\" = hfinal.callCabal2nix packageName src { };\n                http-api-data = hfinal.http-api-data_0_6_1;\n                uuid-types = hfinal.uuid-types_1_0_6;\n                effectful = hfinal.effectful_2_5_0_0;\n                effectful-core = hfinal.effectful-core_2_5_0_0;\n                scotty = hfinal.scotty_0_22;\n                data-default = hfinal.callHackage \"data-default\" \"0.8.0.0\" { };\n              }\n            );\n          });\n          ghc966 = (prev.overriddenHaskellPackages.ghc966 or prev.haskell.packages.ghc966).override (old: {\n            overrides = prev.lib.composeExtensions (old.overrides or (_: _: { })) (\n              hfinal: hprev: {\n                \"${packageName}\" = hfinal.callCabal2nix packageName src { };\n                effectful = hfinal.effectful_2_5_0_0;\n                effectful-core = hfinal.effectful-core_2_5_0_0;\n                http-api-data = hfinal.http-api-data_0_6_1;\n                uuid-types = hfinal.uuid-types_1_0_6;\n                data-default = hfinal.callHackage \"data-default\" \"0.8.0.0\" { };\n              }\n            );\n          });\n        };\n      };\n\n    in\n    {\n      overlays.default = nixpkgs.lib.composeExtensions atomic-css.overlays.default overlay;\n    }\n    // flake-utils.lib.eachDefaultSystem (\n      system:\n      let\n        pkgs = import nixpkgs {\n          inherit system;\n          overlays = [ self.overlays.default ];\n        };\n\n        demo-src = nix-filter.lib {\n          root = ./demo;\n          include = [\n            \"Demo\"\n            (nix-filter.lib.matchExt \"hs\")\n            ./demo/demo.cabal\n            \"docgen\"\n          ];\n        };\n\n        ghcVersions = [\n          \"966\"\n          \"982\"\n        ];\n\n        ghcPkgs = builtins.listToAttrs (\n          map (ghcVer: {\n            name = \"ghc${ghcVer}\";\n            value = (\n              pkgs.overriddenHaskellPackages.\"ghc${ghcVer}\".extend (\n                hfinal: hprev: {\n                  ${demoName} = hfinal.callCabal2nix demoName demo-src { };\n                }\n              )\n            );\n          }) ghcVersions\n        );\n\n        pre-commit = pre-commit-hooks.lib.${system}.run {\n          src = src;\n          hooks = {\n            hlint.enable = true;\n            fourmolu.enable = true;\n            hpack.enable = false;\n            nixfmt-rfc-style.enable = true;\n            flake-checker = {\n              enable = true;\n              args = [ \"--no-telemetry\" ];\n            };\n            check-merge-conflicts.enable = true;\n          };\n        };\n\n        shellCommon = version: {\n          inherit (pre-commit) shellHook;\n          buildInputs = with pkgs.haskell.packages.\"ghc${version}\"; [\n            pkgs.nodePackages_latest.webpack-cli\n            pkgs.nodePackages_latest.webpack\n            pkgs.nodejs\n            cabal-install\n            haskell-language-server\n            fourmolu\n            fast-tags\n            ghcid\n            pkgs.ghciwatch\n            pkgs.hpack\n          ];\n          withHoogle = true;\n          doBenchmark = true;\n          CABAL_CONFIG = \"/dev/null\";\n          LD_LIBRARY_PATH = pkgs.lib.makeLibraryPath [ pkgs.libz ];\n        };\n\n        exe =\n          version:\n          pkgs.haskell.lib.overrideCabal\n            (pkgs.haskell.lib.justStaticExecutables self.packages.${system}.\"ghc${version}-${demoName}\")\n            (drv: {\n              # Added due to an issue building on macOS only\n              postInstall = ''\n                ${drv.postInstall or \"\"}\n                  echo \"Contents of $out/bin:\"\n                  ls -la $out/bin\n                  echo remove-references-to -t ${ghcPkgs.\"ghc${version}\".warp}\n                  remove-references-to -t ${ghcPkgs.\"ghc${version}\".warp} $out/bin/*\n              '';\n            });\n\n        docker =\n          version:\n          pkgs.dockerTools.buildImage {\n            name = demoName;\n            created = \"now\";\n            tag = \"latest\";\n            copyToRoot = pkgs.buildEnv {\n              name = \"image-root\";\n              paths = [\n                pkgs.tree\n                pkgs.bash\n                (exe version)\n                (pkgs.runCommand \"static-files\" { } ''\n                  mkdir -p $out/demo/static\n                  mkdir -p $out/client/dist\n                  cp -r ${./demo/static}/* $out/demo/static/\n                  cp -r ${./client/dist}/* $out/client/dist\n                '')\n              ];\n              pathsToLink = [\n                \"/bin\"\n                \"/demo/static\"\n                \"/client/dist\"\n              ];\n            };\n            config = {\n              Entrypoint = [ \"/bin/demo\" ];\n              WorkingDir = \"/\";\n            };\n          };\n      in\n      {\n        # Rest of the output remains the same...\n        checks = builtins.listToAttrs (\n          map (version: {\n            name = \"ghc${version}-check-${demoName}\";\n            value = pkgs.runCommand \"ghc${version}-check-demo\" {\n              buildInputs = [\n                (exe version)\n              ] ++ self.devShells.${system}.\"ghc${version}-shell\".buildInputs;\n            } \"type demo; type docgen; CABAL_CONFIG=/dev/null cabal --dry-run repl; touch $out\";\n          }) ghcVersions\n        );\n\n        apps =\n          {\n            default = self.apps.${system}.\"ghc966-${demoName}\";\n          }\n          // builtins.listToAttrs (\n            map (version: {\n              name = \"ghc${version}-${demoName}\";\n              value = {\n                type = \"app\";\n                program = \"${exe version}/bin/demo\";\n              };\n            }) ghcVersions\n          );\n\n        packages =\n          {\n            default = self.packages.${system}.\"ghc982-${packageName}\";\n            docker = self.packages.${system}.\"ghc982-docker\";\n          }\n          // builtins.listToAttrs (\n            builtins.concatMap (version: [\n              {\n                name = \"ghc${version}-${demoName}\";\n                value = ghcPkgs.\"ghc${version}\".${demoName};\n              }\n              {\n                name = \"ghc${version}-docker\";\n                value = docker version;\n              }\n              {\n                name = \"ghc${version}-${packageName}\";\n                value = ghcPkgs.\"ghc${version}\".${packageName};\n              }\n            ]) ghcVersions\n          );\n\n        devShells =\n          {\n            default = self.devShells.${system}.ghc982-shell;\n          }\n          // builtins.listToAttrs (\n            map (version: {\n              name = \"ghc${version}-shell\";\n              value = ghcPkgs.\"ghc${version}\".shellFor (\n                shellCommon version\n                // {\n                  packages = p: [\n                    p.${packageName}\n                    p.${demoName}\n                  ];\n                }\n              );\n            }) ghcVersions\n          );\n      }\n    );\n}\n"
  },
  {
    "path": "fourmolu.yaml",
    "content": "# # Number of spaces per indentation step\nindentation: 2\n#\n# # Max line length for automatic line breaking\n# column-limit: none\n\n# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)\nfunction-arrows: leading\n\n# # How to place commas in multi-line lists, records, etc. (choices: leading or trailing)\n# comma-style: leading\n\n# Styling of import/export lists (choices: leading, trailing, or diff-friendly)\nimport-export-style: leading\n\n# # Whether to full-indent or half-indent 'where' bindings past the preceding body\n# indent-wheres: false\n#\n# # Whether to leave a space before an opening record brace\n# record-brace-space: false\n\n# # Number of spaces between top-level declarations\nnewlines-between-decls: 2\n#\n# # How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)\n# haddock-style: multi-line\n#\n# # How to print module docstring\n# haddock-style-module: null\n\n# # Styling of let blocks (choices: auto, inline, newline, or mixed)\n# let-style: auto\n#\n# # How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)\n# in-style: right-align\n#\n# # Whether to put parentheses around a single constraint (choices: auto, always, or never)\n# single-constraint-parens: always\n#\n# # Output Unicode syntax (choices: detect, always, or never)\n# unicode: never\n#\n# Give the programmer more choice on where to insert blank lines\nrespectful: true\n\n# # Fixity information for operators\n# fixities: []\n#\n# # Module reexports Fourmolu should know about\n# reexports: []\n"
  },
  {
    "path": "hie.yaml",
    "content": "cradle:\n  cabal:\n"
  },
  {
    "path": "hyperbole.cabal",
    "content": "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.com/sol/hpack\n\nname:           hyperbole\nversion:        0.6.0\nsynopsis:       Interactive HTML apps using type-safe serverside Haskell\ndescription:    Interactive HTML applications with type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView.\ncategory:       Web, Network\nhomepage:       https://github.com/seanhess/hyperbole\nbug-reports:    https://github.com/seanhess/hyperbole/issues\nauthor:         Sean Hess\nmaintainer:     seanhess@gmail.com\nlicense:        BSD-3-Clause\nlicense-file:   LICENSE\nbuild-type:     Simple\ntested-with:\n    GHC == 9.8.2\n  , GHC == 9.6.6\nextra-source-files:\n    client/dist/hyperbole.js\n    client/dist/hyperbole.js.map\n    client/util/live-reload.js\nextra-doc-files:\n    README.md\n    CHANGELOG.md\n\nsource-repository head\n  type: git\n  location: https://github.com/seanhess/hyperbole\n\nlibrary\n  exposed-modules:\n      Web.Hyperbole\n      Web.Hyperbole.Application\n      Web.Hyperbole.Data.Cookie\n      Web.Hyperbole.Data.Encoded\n      Web.Hyperbole.Data.JSON\n      Web.Hyperbole.Data.Param\n      Web.Hyperbole.Data.QueryData\n      Web.Hyperbole.Data.URI\n      Web.Hyperbole.Document\n      Web.Hyperbole.Effect.Client\n      Web.Hyperbole.Effect.GenRandom\n      Web.Hyperbole.Effect.Hyperbole\n      Web.Hyperbole.Effect.OAuth2\n      Web.Hyperbole.Effect.Query\n      Web.Hyperbole.Effect.Request\n      Web.Hyperbole.Effect.Response\n      Web.Hyperbole.Effect.Session\n      Web.Hyperbole.HyperView\n      Web.Hyperbole.HyperView.Event\n      Web.Hyperbole.HyperView.Forms\n      Web.Hyperbole.HyperView.Handled\n      Web.Hyperbole.HyperView.Hyper\n      Web.Hyperbole.HyperView.Input\n      Web.Hyperbole.HyperView.Types\n      Web.Hyperbole.Page\n      Web.Hyperbole.Route\n      Web.Hyperbole.Server.Handler\n      Web.Hyperbole.Server.Message\n      Web.Hyperbole.Server.Options\n      Web.Hyperbole.Server.Socket\n      Web.Hyperbole.Server.Wai\n      Web.Hyperbole.TypeList\n      Web.Hyperbole.Types.Client\n      Web.Hyperbole.Types.Event\n      Web.Hyperbole.Types.Request\n      Web.Hyperbole.Types.Response\n      Web.Hyperbole.View\n      Web.Hyperbole.View.CSS\n      Web.Hyperbole.View.Embed\n      Web.Hyperbole.View.Render\n      Web.Hyperbole.View.Tag\n      Web.Hyperbole.View.Types\n      Web.Hyperbole.View.ViewAction\n      Web.Hyperbole.View.ViewId\n  other-modules:\n      Paths_hyperbole\n  autogen-modules:\n      Paths_hyperbole\n  hs-source-dirs:\n      src\n  default-extensions:\n      OverloadedStrings\n      OverloadedRecordDot\n      DuplicateRecordFields\n      NoFieldSelectors\n      TypeFamilies\n      DataKinds\n      DerivingStrategies\n      DeriveAnyClass\n  ghc-options: -Wall -fdefer-typed-holes\n  build-depends:\n      aeson >=2.1.2.1 && <2.3\n    , atomic-css ==0.2.*\n    , attoparsec ==0.14.*\n    , attoparsec-aeson >=2.1 && <2.3\n    , base >=4.16 && <5\n    , bytestring >=0.11 && <0.13\n    , casing >=0.1.2 && <0.2\n    , containers >=0.6 && <1\n    , cookie >=0.4 && <0.6\n    , data-default ==0.8.*\n    , effectful >=2.4 && <3\n    , file-embed >=0.0.10 && <0.1\n    , filepath >=1.4 && <2\n    , http-api-data >=0.6 && <0.8\n    , http-client ==0.7.*\n    , http-client-tls ==0.3.*\n    , http-types ==0.12.*\n    , network >=3.1 && <4\n    , network-uri >=2.6.4.1 && <2.7\n    , random >=1.2 && <2\n    , string-conversions ==0.4.*\n    , string-interpolate ==0.3.*\n    , text >=1.2 && <3\n    , time >=1.12 && <2\n    , wai >=3.2 && <4\n    , wai-websockets >=3.0 && <4\n    , warp >=3.3 && <4\n    , websockets >=0.12 && <0.14\n  default-language: GHC2021\n\ntest-suite test\n  type: exitcode-stdio-1.0\n  main-is: Spec.hs\n  other-modules:\n      Test.EncodedSpec\n      Test.FormSpec\n      Test.ParamSpec\n      Test.QuerySpec\n      Test.RouteSpec\n      Test.SessionSpec\n      Test.URISpec\n      Test.ViewActionSpec\n      Test.ViewIdSpec\n      Test.ViewSpec\n      Paths_hyperbole\n  autogen-modules:\n      Paths_hyperbole\n  hs-source-dirs:\n      test\n  default-extensions:\n      OverloadedStrings\n      OverloadedRecordDot\n      DuplicateRecordFields\n      NoFieldSelectors\n      TypeFamilies\n      DataKinds\n      DerivingStrategies\n      DeriveAnyClass\n  ghc-options: -Wall -fdefer-typed-holes -threaded -rtsopts -with-rtsopts=-N -F -pgmF=skeletest-preprocessor\n  build-tool-depends:\n      skeletest:skeletest-preprocessor\n  build-depends:\n      aeson >=2.1.2.1 && <2.3\n    , atomic-css ==0.2.*\n    , attoparsec ==0.14.*\n    , attoparsec-aeson >=2.1 && <2.3\n    , base >=4.16 && <5\n    , bytestring >=0.11 && <0.13\n    , casing >=0.1.2 && <0.2\n    , containers >=0.6 && <1\n    , cookie >=0.4 && <0.6\n    , data-default ==0.8.*\n    , effectful >=2.4 && <3\n    , file-embed >=0.0.10 && <0.1\n    , filepath >=1.4 && <2\n    , http-api-data >=0.6 && <0.8\n    , http-client ==0.7.*\n    , http-client-tls ==0.3.*\n    , http-types ==0.12.*\n    , hyperbole\n    , network >=3.1 && <4\n    , network-uri >=2.6.4.1 && <2.7\n    , random >=1.2 && <2\n    , skeletest\n    , string-conversions ==0.4.*\n    , string-interpolate ==0.3.*\n    , text >=1.2 && <3\n    , time >=1.12 && <2\n    , wai >=3.2 && <4\n    , wai-websockets >=3.0 && <4\n    , warp >=3.3 && <4\n    , websockets >=0.12 && <0.14\n  default-language: GHC2021\n"
  },
  {
    "path": "package.yaml",
    "content": "name:               hyperbole\nversion:            0.6.0\nsynopsis:           Interactive HTML apps using type-safe serverside Haskell\nhomepage:           https://github.com/seanhess/hyperbole\ngithub:             seanhess/hyperbole\nlicense:            BSD-3-Clause\nlicense-file:       LICENSE\nauthor:             Sean Hess\nmaintainer:         seanhess@gmail.com\ncategory:           Web, Network\ndescription:        Interactive HTML applications with type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView.\n\nextra-doc-files:\n  - README.md\n  - CHANGELOG.md\n\nextra-source-files:\n  - client/dist/hyperbole.js\n  - client/dist/hyperbole.js.map\n  - client/util/live-reload.js\n\nlanguage: GHC2021\n\nghc-options:\n  - -Wall\n  - -fdefer-typed-holes\n\ntested-with:\n  - GHC == 9.8.2\n  - GHC == 9.6.6\n\ndefault-extensions:\n  - OverloadedStrings\n  - OverloadedRecordDot\n  - DuplicateRecordFields\n  - NoFieldSelectors\n  - TypeFamilies\n  - DataKinds\n  - DerivingStrategies\n  - DeriveAnyClass\n\ndependencies:\n  - base >=4.16 && <5\n  - aeson >= 2.1.2.1 && <2.3\n  - attoparsec >= 0.14 && < 0.15\n  - attoparsec-aeson >= 2.1 && < 2.3\n  - bytestring >= 0.11 && <0.13\n  - containers >= 0.6 && <1\n  - casing >= 0.1.2 && <0.2\n  - data-default >= 0.8 && <0.9\n  - effectful >= 2.4 && <3\n  - text >= 1.2 && <3\n  - time >= 1.12 && <2\n  - random >= 1.2 && < 2\n  - string-interpolate >= 0.3 && <0.4\n  - file-embed >= 0.0.10 && <0.1\n  - http-api-data >= 0.6 && <0.8\n  - http-types >= 0.12 && <0.13\n  - network-uri >=2.6.4.1 && <2.7\n  - wai >= 3.2 && <4\n  - warp >= 3.3 && <4\n  - atomic-css >= 0.2 && < 0.3\n  - string-conversions >= 0.4 && <0.5\n  - wai-websockets >= 3.0 && <4\n  - network >= 3.1 && <4\n  - websockets >= 0.12 && <0.14\n  - cookie >=0.4 && <0.6\n  - filepath >= 1.4 && < 2\n  - http-client >= 0.7 && < 0.8\n  - http-client-tls >= 0.3 && < 0.4\n\nlibrary:\n  source-dirs:\n    - src\n\ntests:\n  test:\n    main:        Spec.hs\n    source-dirs: test\n    build-tools: skeletest:skeletest-preprocessor\n    ghc-options:\n    - -threaded\n    - -rtsopts\n    - -with-rtsopts=-N\n    - -F -pgmF=skeletest-preprocessor\n    dependencies:\n      - hyperbole\n      - skeletest\n"
  },
  {
    "path": "src/Web/Hyperbole/Application.hs",
    "content": "module Web.Hyperbole.Application\n  ( waiApp\n  , websocketsOr\n  , defaultConnectionOptions\n  , liveApp\n  , liveAppWith\n  , ServerOptions (..)\n  , defaultErrorMessage\n  , defaultError\n  , socketApp\n  , quickStartDocument\n  , routeRequest\n  ) where\n\nimport Control.Exception\nimport Control.Monad (forever)\nimport Data.ByteString.Lazy qualified as BL\nimport Effectful\nimport Effectful.Concurrent.Async\nimport Effectful.Concurrent.STM (TVar)\nimport GHC.Conc (newTVarIO)\nimport Network.Wai qualified as Wai\nimport Network.Wai.Handler.WebSockets (websocketsOr)\nimport Network.WebSockets (ConnectionException (..), PendingConnection, defaultConnectionOptions, withPingThread)\nimport Network.WebSockets qualified as WS\nimport Web.Hyperbole.Document\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Effect.Request (reqPath)\nimport Web.Hyperbole.Effect.Response (notFound)\nimport Web.Hyperbole.Route\nimport Web.Hyperbole.Server.Options\nimport Web.Hyperbole.Server.Socket (RunningActions, handleRequestSocket)\nimport Web.Hyperbole.Server.Wai (handleRequestWai)\nimport Web.Hyperbole.Types.Response\n\n\n{- | Turn one or more 'Page's into a Wai Application. Respond using both HTTP and WebSockets\n\n> #EMBED Example.Docs.BasicPage main\n-}\nliveApp :: (BL.ByteString -> BL.ByteString) -> Eff '[Hyperbole, Concurrent, IOE] Response -> Wai.Application\nliveApp doc =\n  liveAppWith $\n    ServerOptions\n      { toDocument = doc\n      , serverError = defaultError\n      }\n\n\n-- | Run a Hyperbole application, customizing both the document and the format of server errors\nliveAppWith :: ServerOptions -> Eff '[Hyperbole, Concurrent, IOE] Response -> Wai.Application\nliveAppWith opts eff req = do\n  websocketsOr\n    defaultConnectionOptions\n    (\\pend -> socketApp opts req eff pend `catch` suppressMessages)\n    (waiApp opts eff)\n    req\n\n\nwaiApp :: ServerOptions -> Eff '[Hyperbole, Concurrent, IOE] Response -> Wai.Application\nwaiApp opts eff req res = do\n  runEff $ runConcurrent $ handleRequestWai opts req res eff\n\n\nsocketApp :: (MonadIO m) => ServerOptions -> Wai.Request -> Eff '[Hyperbole, Concurrent, IOE] Response -> PendingConnection -> m ()\nsocketApp opts req eff pend = liftIO $ do\n  -- private TVar for each client\n  actions :: TVar RunningActions <- liftIO $ newTVarIO mempty\n  conn <- WS.acceptRequest pend\n  withPingThread conn 25 (pure ()) $ do\n    forever $ do\n      runEff $ runConcurrent $ handleRequestSocket opts actions req conn eff\n\n\nsuppressMessages :: ConnectionException -> IO a\nsuppressMessages ex = do\n  -- The default version of Network.Websockets prints out CloseRequest and ConnectionClosed errors\n  -- it's like they're using these as events instead of exceptions\n  case ex of\n    ConnectionClosed -> do\n      -- putStrLn \"CAUGHT ConnectionClosed\"\n      pure undefined\n    CloseRequest _cd _msg -> do\n      -- putStrLn \"CAUGHT CloseRequest\"\n      pure undefined\n    other -> throwIO other\n\n\n{- | Route URL patterns to different pages\n\n\n@\n#EMBED Example.Docs.App type UserId\n\n#EMBED Example.Docs.App data AppRoute\n\n#EMBED Example.Docs.App instance Route\n\n#EMBED Example.Docs.App router\n\n#EMBED Example.Docs.App app\n@\n-}\nrouteRequest :: (Hyperbole :> es, Route route) => (route -> Eff es Response) -> Eff es Response\nrouteRequest actions = do\n  pth <- reqPath\n  maybe notFound actions $ matchRoute pth\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/Cookie.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Web.Hyperbole.Data.Cookie where\n\nimport Data.ByteString (ByteString)\nimport Data.Map.Strict (Map)\nimport Data.Map.Strict qualified as M\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Network.HTTP.Types (urlDecode, urlEncode)\nimport Web.Hyperbole.Data.URI\n\n\ntype Key = Text\n\n\ndata Cookie = Cookie\n  { key :: Key\n  , path :: Maybe Path\n  , value :: Maybe CookieValue\n  , secure :: Bool\n  }\n  deriving (Show, Eq)\n\n\nnewtype Cookies = Cookies (Map Key Cookie)\n  deriving newtype (Monoid, Semigroup, Show, Eq)\n\n\nnewtype CookieValue = CookieValue ByteString\n  deriving newtype (Show, Eq)\n\n\ninsert :: Cookie -> Cookies -> Cookies\ninsert cookie (Cookies m) =\n  Cookies $ M.insert cookie.key cookie m\n\n\ndelete :: Key -> Cookies -> Cookies\ndelete key (Cookies m) =\n  Cookies $ M.delete key m\n\n\nlookup :: Key -> Cookies -> Maybe CookieValue\nlookup key (Cookies m) = do\n  cook <- M.lookup key m\n  cook.value\n\n\nfromList :: [Cookie] -> Cookies\nfromList cks = Cookies $ M.fromList (fmap keyValue cks)\n where\n  keyValue c = (c.key, c)\n\n\ntoList :: Cookies -> [Cookie]\ntoList (Cookies m) = M.elems m\n\n\nrender :: Path -> Cookie -> ByteString\nrender requestPath cookie =\n  let p = fromMaybe requestPath cookie.path\n      secureFlag = if cookie.secure then \"; secure\" else \"\"\n      sameSite = if cookie.secure then \"; SameSite=None\" else \"; SameSite=Lax\"\n   in cs cookie.key <> \"=\" <> value cookie.value <> sameSite <> secureFlag <> \"; path=\" <> cs (uriToText (pathUri p))\n where\n  value Nothing = \"; expires=Thu, 01 Jan 1970 00:00:00 GMT\"\n  value (Just (CookieValue val)) = urlEncode True $ cs val\n\n\nparse :: [(ByteString, ByteString)] -> Either String Cookies\nparse kvs = do\n  cks <- mapM (uncurry parseValue) kvs\n  pure $ fromList cks\n\n\nparseValue :: ByteString -> ByteString -> Either String Cookie\nparseValue k val = do\n  let cval = CookieValue $ cs $ urlDecode True val\n  pure $ Cookie (cs k) Nothing (Just $ cval) True\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/Encoded.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE OverloadedLists #-}\n\nmodule Web.Hyperbole.Data.Encoded where\n\nimport Data.Aeson (FromJSON (..), ToJSON (..), Value (..))\nimport Data.Aeson qualified as A\nimport Data.Attoparsec.ByteString qualified as AB\nimport Data.Attoparsec.ByteString qualified as Atto\nimport Data.Attoparsec.ByteString.Char8 (isSpace, sepBy, takeWhile1)\nimport Data.Attoparsec.ByteString.Char8 qualified as AC\nimport Data.Bifunctor (first)\nimport Data.String (IsString)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport GHC.Generics\nimport Web.Hyperbole.Data.Param\n\n\nnewtype ConName = ConName {text :: Text}\n  deriving newtype (Eq, Show, IsString, Ord)\ninstance Semigroup ConName where\n  -- Ignore the second constructor name\n  c1 <> _ = c1\ninstance Monoid ConName where\n  mempty = ConName \"\"\n\n\n{- | Pretty Human Readable top-levelencoding for ViewAction and ViewId\nFor simple Sum and Product types it is equivalent to the Show/Read instance\n\nMyConstructor 1 2 3\n-}\ndata Encoded = Encoded ConName [ParamValue]\n  deriving (Show, Eq, Ord)\n\n\ninstance Semigroup Encoded where\n  Encoded c1 es1 <> Encoded c2 es2 =\n    Encoded (c1 <> c2) (es1 <> es2)\ninstance Monoid Encoded where\n  mempty = Encoded mempty mempty\ninstance ToJSON Encoded where\n  toJSON e = toJSON $ encode e\ninstance FromJSON Encoded where\n  parseJSON (String t) =\n    case decodeEither t of\n      Left e -> fail $ \"Encoded \" <> cs e\n      Right a -> pure a\n  parseJSON val = fail $ \"Expected Encoded but got: \" <> show val\n\n\nencode :: (ToEncoded a) => a -> Text\nencode a = encodedToText $ toEncoded a\n\n\ndecode :: (FromEncoded a) => Text -> Maybe a\ndecode t = either (const Nothing) Just $ decodeEither t\n\n\ndecodeEither :: (FromEncoded a) => Text -> Either String a\ndecodeEither t = do\n  enc <- encodedParseText t\n  parseEncoded enc\n\n\n-- | Basic Encoding\nencodedToText :: Encoded -> Text\nencodedToText (Encoded con values) =\n  T.intercalate \" \" (con.text : fmap encodeParam values)\n\n\nencodedParseText :: Text -> Either String Encoded\nencodedParseText inp =\n  first cs $ AB.parseOnly encodedParser (cs inp)\n where\n  encodedParser :: AB.Parser Encoded\n  encodedParser = do\n    con <- AC.takeTill AC.isSpace\n    AC.skipSpace\n    ps <- paramParser `sepBy` AC.char ' '\n    pure $ Encoded (ConName (cs con)) ps\n\n\ngenericToEncoded :: (Generic a, GToEncoded (Rep a)) => a -> Encoded\ngenericToEncoded a = gToEncoded (from a)\n\n\ngenericParseEncoded :: (Generic a, GFromEncoded (Rep a)) => Encoded -> Either String a\ngenericParseEncoded enc = do\n  (gen, _) <- gParseEncoded enc\n  pure $ to gen\n\n\ngenericDecode :: (Generic a, GFromEncoded (Rep a)) => Text -> Maybe a\ngenericDecode t = either (const Nothing) Just $ do\n  enc <- encodedParseText t\n  genericParseEncoded enc\n\n\n-- | Custom Encoding for embedding into web documents. Noteably used for 'ViewId' and 'ViewAction'\nclass ToEncoded a where\n  toEncoded :: a -> Encoded\n  default toEncoded :: (Generic a, GToEncoded (Rep a)) => a -> Encoded\n  toEncoded = genericToEncoded\n\n\ninstance ToEncoded Encoded where\n  toEncoded = id\ninstance ToEncoded () where\n  toEncoded _ = mempty\ninstance ToEncoded ParamValue where\n  toEncoded p = Encoded mempty [toParam p]\ninstance ToEncoded Int where\n  toEncoded = toEncoded . toParam\ninstance ToEncoded Text where\n  toEncoded = toEncoded . toParam\n\n\n-- | Custom Encoding for embedding into web documents. Noteably used for 'ViewId' and 'ViewAction'\nclass FromEncoded a where\n  parseEncoded :: Encoded -> Either String a\n  default parseEncoded :: (Generic a, GFromEncoded (Rep a)) => Encoded -> Either String a\n  parseEncoded = genericParseEncoded\n\n\ninstance FromEncoded Encoded where\n  parseEncoded = pure\ninstance FromEncoded () where\n  parseEncoded _ = pure ()\ninstance FromEncoded ParamValue where\n  parseEncoded (Encoded _ ps) = do\n    case ps of\n      [p] -> parseParam p\n      _ -> Left $ \"Expected single param value [param] but got: \" <> show ps\ninstance FromEncoded Int where\n  parseEncoded enc = parseEncoded enc >>= parseParam\ninstance FromEncoded Text where\n  parseEncoded enc = parseEncoded enc >>= parseParam\n\n\nfromResult :: A.Result a -> Either String a\nfromResult (A.Success a) = pure a\nfromResult (A.Error e) = Left (cs e)\n\n\n-------------------------------------------------------------------------------\n-- PARAM ENCODING\n-------------------------------------------------------------------------------\n-- Params need to be sanitized and escaped, because we want to use spaces to separate our params\n-- Data.Param by default does not sanitize spaces\n\nparamParser :: Atto.Parser ParamValue\nparamParser = do\n  t <- takeWhile1 (not . isSpace)\n  pure $ decodeParam $ cs t\n\n\ndecodeParam :: Text -> ParamValue\ndecodeParam = \\case\n  \"|\" -> ParamValue \"\"\n  t -> ParamValue $ desanitizeParamText t\n\n\n-- Param encoding scheme:\n--   Wire format must not contain bare spaces (field separator) or real newlines.\n--   We use backslash as the escape character:\n--     '\\'  → \"\\\\\"    (escape backslash itself, so it cannot be confused with an escape prefix)\n--     '\\n' → \"\\n\"    (literal backslash + 'n', for real newline characters)\n--     '_'  → \"\\_\"    (escape underscore, since bare underscore encodes space)\n--     ' '  → \"_\"     (encode space as underscore)\n--   Decoding is the single-pass reverse of the above.\n--\n-- The critical invariant: backslash is escaped FIRST on encode and unescaped\n-- LAST on decode.  This ensures that JSON escape sequences (e.g. the two chars\n-- '\\' 'n' inside \"[\\\"\\n\\\"]\") are treated as an escaped backslash followed by\n-- a plain 'n', not as the param newline escape.\n-- See: https://github.com/seanhess/hyperbole/issues/187\n\ndesanitizeParamText :: Text -> Text\ndesanitizeParamText = go\n where\n  go t = case T.uncons t of\n    Nothing -> \"\"\n    Just ('\\\\', rest) -> case T.uncons rest of\n      Just ('\\\\', rest') -> T.cons '\\\\' (go rest')   -- \\\\ → \\\n      Just ('n', rest')  -> T.cons '\\n' (go rest')   -- \\n → newline\n      Just ('_', rest')  -> T.cons '_' (go rest')    -- \\_ → _\n      _                  -> T.cons '\\\\' (go rest)    -- bare backslash (shouldn't occur)\n    Just ('_', rest) -> T.cons ' ' (go rest)         -- _ → space\n    Just (c, rest)   -> T.cons c (go rest)            -- other chars verbatim\n\n\n--   | T.isSuffixOf \"\\\\\" seg = T.dropEnd 1 seg <> \"_\" <> txt\n--   | otherwise = seg <> \" \" <> txt\n\n-- foldr join \"\" $\n-- where\n--\n-- join \"\" \"\" = \" \"\n-- join \"\" \" \" = \" \"\n-- join seg \"\" = seg\n-- join seg txt\n--   | T.isSuffixOf \"\\\\\" seg = T.dropEnd 1 seg <> \"_\" <> txt\n--   | otherwise = seg <> \" \" <> txt\n\nencodeParam :: ParamValue -> Text\nencodeParam (ParamValue t) =\n  case t of\n    \"\" -> \"|\"\n    _ -> sanitizeParamText t\n where\n  -- Encode a param value for the wire format.\n  -- Backslash MUST be escaped first (before newline), otherwise a literal\n  -- backslash followed by 'n' in the input (e.g. from JSON encoding) would\n  -- be indistinguishable from the newline escape on the wire.\n  -- See: https://github.com/seanhess/hyperbole/issues/187\n  sanitizeParamText :: Text -> Text\n  sanitizeParamText =\n    T.replace \" \" \"_\" . T.replace \"_\" \"\\\\_\" . T.replace \"\\n\" \"\\\\n\" . T.replace \"\\\\\" \"\\\\\\\\\"\n\n\n-- decodeParamValue :: (FromParam a) => Text -> Either String a\n-- decodeParamValue = parseParam . decodeParam\n\n-- decodeParam :: Text -> ParamValue\n-- decodeParam inp = do\n--   case A.eitherDecode (cs inp) of\n--     Left _ -> paramFromText inp\n--     Right v -> ParamValue inp v\n\n-------------------------------------------------------------------------------\n-- GENERICS\n-------------------------------------------------------------------------------\n\n-- GToEncoded: Generic ViewAction Encoding\n\nclass GToEncoded f where\n  gToEncoded :: f p -> Encoded\n\n\ninstance (GToEncoded f, GToEncoded g) => GToEncoded (f :+: g) where\n  gToEncoded (L1 f) = gToEncoded f\n  gToEncoded (R1 f) = gToEncoded f\n\n\ninstance (GToEncoded f, GToEncoded g) => GToEncoded (f :*: g) where\n  gToEncoded (f :*: g) =\n    gToEncoded f <> gToEncoded g\n\n\ninstance GToEncoded U1 where\n  -- WARNING: not sure if this will work\n  gToEncoded U1 = mempty\n\n\ninstance (GToEncoded f) => GToEncoded (M1 D d f) where\n  gToEncoded (M1 f) = gToEncoded f\n\n\ninstance (Constructor c, GToEncoded f) => GToEncoded (M1 C c f) where\n  gToEncoded (M1 f) =\n    let con = cs (conName (undefined :: M1 C c f p))\n     in Encoded (ConName con) mempty <> gToEncoded f\n\n\ninstance (GToEncoded f) => GToEncoded (M1 S s f) where\n  gToEncoded (M1 f) = gToEncoded f\n\n\ninstance (ToParam a) => GToEncoded (K1 R a) where\n  gToEncoded (K1 a) = Encoded mempty [toParam a]\n\n\n-- GFromEncoded: Generic ViewAction Decoding\n\nclass GFromEncoded f where\n  gParseEncoded :: Encoded -> Either String (f p, [ParamValue])\n\n\ninstance (GFromEncoded f, GFromEncoded g) => GFromEncoded (f :+: g) where\n  gParseEncoded enc@(Encoded con vals) = do\n    let el = gParseEncoded @f enc\n    let er = gParseEncoded @g enc\n    case (el, er) of\n      (Right (l, lvals), _) -> pure (L1 l, lvals)\n      (_, Right (r, rvals)) -> pure (R1 r, rvals)\n      (Left _, Left _) ->\n        Left $ \"No matching sum constructor: \" <> cs con.text <> \" \" <> cs (show vals)\n\n\ninstance (GFromEncoded f, GFromEncoded g) => GFromEncoded (f :*: g) where\n  gParseEncoded (Encoded con vals) = do\n    (a, rest) <- gParseEncoded @f (Encoded con vals)\n    (b, gone) <- gParseEncoded @g (Encoded con rest)\n    pure (a :*: b, gone)\n\n\ninstance GFromEncoded U1 where\n  gParseEncoded (Encoded _ vals) = pure (U1, vals)\n\n\ninstance (GFromEncoded f) => GFromEncoded (M1 D d f) where\n  gParseEncoded enc = do\n    first M1 <$> gParseEncoded enc\n\n\ninstance (Constructor c, GFromEncoded f) => GFromEncoded (M1 C c f) where\n  gParseEncoded enc@(Encoded cname _) = do\n    if cs cname.text == con\n      then first M1 <$> gParseEncoded @f enc\n      else Left $ \"Mismatched Constructor \" <> cs cname.text <> \" /= \" <> con\n   where\n    con = cs $ conName (undefined :: M1 C c f p)\n\n\ninstance (GFromEncoded f) => GFromEncoded (M1 S s f) where\n  gParseEncoded enc = do\n    (a, rest) <- gParseEncoded enc\n    pure (M1 a, rest)\n\n\ninstance (FromParam a) => GFromEncoded (K1 R a) where\n  gParseEncoded (Encoded con vals) = do\n    case vals of\n      (param : rest) -> do\n        case parseParam param of\n          -- consume one param\n          Right a -> pure (K1 a, rest)\n          Left e -> Left (cs e)\n      [] -> Left $ \"Missing parameters for Encoded Constructor:\" <> cs con.text\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/JSON.hs",
    "content": "module Web.Hyperbole.Data.JSON (JSON (..), ToJSON, FromJSON) where\n\nimport Data.Aeson as A\nimport Data.String.Conversions (cs)\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.Param\n\n\n-- JSON Encoded Data ------------------------------------\n\n-- | This type always encodes data via JSON\nnewtype JSON a = JSON a\n\n\ninstance (ToJSON a) => ToEncoded (JSON a) where\n  toEncoded (JSON a) = Encoded \"\" [jsonParam a]\ninstance (FromJSON a) => FromEncoded (JSON a) where\n  parseEncoded (Encoded _ [ParamValue t]) = do\n    JSON <$> A.eitherDecode (cs t)\n  parseEncoded (Encoded _ prms) = do\n    Left $ \"Could not parse JSON Encoded, expected one param: \" <> show prms\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/Param.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n\nmodule Web.Hyperbole.Data.Param where\n\nimport Data.Aeson (FromJSON, GFromJSON, GToJSON, Options (..), SumEncoding (..), ToJSON, Value (..), Zero, defaultOptions, genericParseJSON, genericToJSON)\nimport Data.Aeson qualified as A\nimport Data.Aeson.Types qualified as A\nimport Data.Bifunctor (first)\nimport Data.String (IsString (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Time.Clock (UTCTime)\nimport Data.Word\nimport GHC.Exts (IsList (..))\nimport GHC.Generics\nimport Text.Read (readMaybe)\nimport Web.HttpApiData (FromHttpApiData, ToHttpApiData)\nimport Web.HttpApiData qualified as HttpApiData\nimport Web.Hyperbole.Data.URI (URI (..), parseURIReference, uriToText)\n\n\nnewtype Param = Param {text :: Text}\n  deriving newtype (Show, Eq, Ord, IsString)\n\n\n-- | Encode arbitrarily complex data into url form encoded data\nnewtype ParamValue = ParamValue {value :: Text}\n  deriving newtype (Ord, Eq)\n  deriving (Show, Generic)\n\n\ninstance IsString ParamValue where\n  fromString s = ParamValue (cs s)\n\n\n{- | 'session's, 'form's, and 'query's all encode data as query strings. ToParam and FromParam control how a datatype is encoded to a parameter.\n -\nThis is equivalent to Web.HttpApiData, which is missing some instances and has some strange defaults\n\n@\n#EMBED Example.Docs.Sessions data AppColor\n@\n-}\nclass ToParam a where\n  toParam :: a -> ParamValue\n  default toParam :: (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue\n  toParam = genericToParam\n\n\ninstance ToParam ParamValue where\n  toParam = id\ninstance ToParam Int where\n  toParam = jsonParam\ninstance ToParam Integer where\n  toParam = jsonParam\ninstance ToParam Text where\n  toParam = toQueryParam\ninstance {-# OVERLAPS #-} ToParam String where\n  toParam = toQueryParam\ninstance ToParam Float where\n  toParam = jsonParam\ninstance ToParam Double where\n  toParam = jsonParam\ninstance ToParam Word where\n  toParam = jsonParam\ninstance ToParam Word8 where\n  toParam = jsonParam\ninstance ToParam Word16 where\n  toParam = jsonParam\ninstance ToParam Word32 where\n  toParam = jsonParam\ninstance ToParam Word64 where\n  toParam = jsonParam\ninstance ToParam Bool where\n  toParam = jsonParam\ninstance ToParam Char where\n  toParam = toQueryParam\ninstance ToParam UTCTime where\n  toParam = toQueryParam\ninstance ToParam URI where\n  toParam = toParam . uriToText\ninstance ToParam Value where\n  toParam = jsonParam\ninstance (ToParam a, ToParam b) => ToParam (a, b) where\n  toParam (a, b) = toParam [toParam a, toParam b]\n\n\n{- | Decode data from a 'query', 'session', or 'form' parameter value\n\n@\n#EMBED Example.Docs.Sessions data AppColor\n@\n-}\nclass FromParam a where\n  parseParam :: ParamValue -> Either String a\n  default parseParam :: (Generic a, GFromJSON Zero (Rep a)) => ParamValue -> Either String a\n  parseParam = genericParseParam\n\n\n  decodeFormValue :: Maybe Text -> Either String a\n  decodeFormValue mval = do\n    case mval of\n      Nothing -> Left \"missing form field value\"\n      Just t -> do\n        parseParam $ ParamValue t\n\n\n-- decodeParamValue :: Text -> Either String a\n-- decodeParamValue = parseParam . decodeParam\n\n-- Permissive instances. Some of these come directly from forms!\ninstance FromParam ParamValue where\n  parseParam = pure\ninstance FromParam Int where\n  parseParam \"\" = pure 0\n  parseParam p = jsonParse p\ninstance FromParam Integer where\n  parseParam \"\" = pure 0\n  parseParam p = jsonParse p\ninstance FromParam Float where\n  parseParam \"\" = pure 0\n  parseParam p = jsonParse p\ninstance FromParam Double where\n  parseParam \"\" = pure 0\n  parseParam p = jsonParse p\ninstance FromParam Text where\n  parseParam = parseQueryParam\ninstance (FromParam a, FromParam b) => FromParam (a, b) where\n  parseParam p = do\n    ps <- parseParam @[ParamValue] p\n    case ps of\n      [pa, pb] -> (,) <$> parseParam pa <*> parseParam pb\n      _ -> Left $ \"Expected [a,b] but got: \" <> cs p.value\n\n\n-- -- we don't need to desanitize the text\n-- parseFormField [inp] = do\n--   parseParam $ ParamValue inp (String inp)\n\ninstance {-# OVERLAPS #-} FromParam String where\n  parseParam p = cs <$> parseQueryParam @Text p\n\n\n-- parseFormField sel f = do\n--   inp :: Text <- first cs $ FE.parseUnique @Text (cs sel) f\n--   parseParam $ ParamValue inp (String inp)\ninstance FromParam Word where\n  parseParam = jsonParse\ninstance FromParam Word8 where\n  parseParam = jsonParse\ninstance FromParam Word16 where\n  parseParam = jsonParse\ninstance FromParam Word32 where\n  parseParam = jsonParse\ninstance FromParam Word64 where\n  parseParam = jsonParse\ninstance FromParam Bool where\n  parseParam (ParamValue t) =\n    case t of\n      \"on\" -> pure True\n      \"off\" -> pure False\n      \"\" -> pure False\n      \"false\" -> pure False\n      \"true\" -> pure True\n      other -> Left $ \"Could not parse bool param: \" <> cs other\n\n\n  decodeFormValue Nothing = pure False\n  decodeFormValue (Just t) =\n    parseParam $ ParamValue t\n\n\ninstance FromParam Char where\n  parseParam = parseQueryParam\ninstance FromParam UTCTime where\n  parseParam = parseQueryParam\ninstance FromParam Value where\n  parseParam = jsonParse\n\n\ninstance FromParam URI where\n  parseParam (ParamValue t) = do\n    case parseURIReference (cs t) of\n      Nothing -> Left $ \"Invalid URI: \" <> cs t\n      Just u -> pure u\n\n\ninstance {-# OVERLAPPABLE #-} (ToParam a) => ToParam [a] where\n  toParam as =\n    -- JSON encode the individual params\n    let ps :: [ParamValue] = fmap toParam as\n     in toParam $ Array $ fromList $ fmap (String . (.value)) ps\ninstance {-# OVERLAPPABLE #-} (FromParam a) => FromParam [a] where\n  parseParam p = do\n    ts <- jsonParse @[Text] p\n    mapM (parseParam . ParamValue) ts\n\n\ninstance (ToParam a) => ToParam (Maybe a) where\n  toParam Nothing = ParamValue \"~\"\n  toParam (Just a) = toParam a\ninstance {-# OVERLAPPABLE #-} (FromParam a) => FromParam (Maybe a) where\n  parseParam (ParamValue \"\") = pure Nothing\n  parseParam (ParamValue \"~\") = pure Nothing\n  parseParam t = Just <$> parseParam @a t\n\n\n  decodeFormValue Nothing = pure Nothing\n  decodeFormValue (Just t) = do\n    parseParam @(Maybe a) (ParamValue t)\n\n\ninstance {-# OVERLAPS #-} FromParam (Maybe Text) where\n  parseParam (ParamValue \"~\") = pure Nothing\n  -- keep empty strings, the default instance discards them\n  parseParam (ParamValue \"\") = pure (Just \"\")\n  parseParam t = Just <$> parseParam @Text t\n\n\n  decodeFormValue Nothing = pure Nothing\n  decodeFormValue (Just t) = do\n    parseParam @(Maybe Text) (ParamValue t)\n\n\ninstance (ToParam a, ToParam b) => ToParam (Either a b) where\n  toParam (Left a) = toParam a\n  toParam (Right b) = toParam b\ninstance (FromParam a, FromParam b) => FromParam (Either a b) where\n  parseParam val =\n    case parseParam @a val of\n      Right a -> pure $ Left a\n      Left _ -> do\n        case parseParam @b val of\n          Left _ -> Left $ \"Could not parse Either param: \" <> show val\n          Right b -> pure $ Right b\n\n\nparseQueryParam :: (FromHttpApiData a) => ParamValue -> Either String a\nparseQueryParam (ParamValue t) =\n  first cs $ HttpApiData.parseQueryParam t\n\n\ntoQueryParam :: (ToHttpApiData a) => a -> ParamValue\ntoQueryParam a =\n  ParamValue $ HttpApiData.toQueryParam a\n\n\n-- | Encode a Show as a query param\nshowParam :: (Show a) => a -> ParamValue\nshowParam a = toQueryParam $ show a\n\n\n-- | Decode a Read as a query param\nreadParam :: (Read a) => ParamValue -> Either String a\nreadParam p = do\n  str <- parseQueryParam p\n  case readMaybe str of\n    Nothing -> Left $ cs $ \"Could not read query param: \" <> str\n    Just a -> pure a\n\n\ngenericToParam :: (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue\ngenericToParam a =\n  case genericToJSON jsonOptions a of\n    String t -> ParamValue t\n    other -> jsonParam other\n\n\ngenericParseParam :: (Generic a, GFromJSON Zero (Rep a)) => ParamValue -> Either String a\ngenericParseParam (ParamValue t) = do\n  val <- maybe (pure $ String t) pure $ A.decode (cs t)\n  A.parseEither (genericParseJSON jsonOptions) val\n\n\n-- Encoding ------------------------------------------------------------\n\njsonOptions :: A.Options\njsonOptions = defaultOptions{sumEncoding = TwoElemArray}\n\n\njsonParam :: (ToJSON a) => a -> ParamValue\njsonParam a = ParamValue (cs $ A.encode a)\n\n\njsonParse :: (FromJSON a) => ParamValue -> Either String a\njsonParse (ParamValue t) = do\n  A.eitherDecode (cs t)\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/QueryData.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.Data.QueryData where\n\nimport Data.Aeson (Value (Null))\nimport Data.ByteString (ByteString)\nimport Data.Default (Default (..))\nimport Data.Map.Strict (Map)\nimport Data.Map.Strict qualified as M\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, pack)\nimport GHC.Exts (IsList (..))\nimport GHC.Generics\nimport Network.HTTP.Types (Query, QueryItem, renderQuery)\nimport Network.HTTP.Types qualified as HTTP\nimport Web.Hyperbole.Data.Encoded (decodeParam, encodeParam)\nimport Web.Hyperbole.Data.Param\nimport Prelude hiding (lookup)\n\n\n-- | Key-value store for query params and sessions\nnewtype QueryData = QueryData (Map Param ParamValue)\n  deriving (Show)\n  deriving newtype (Monoid, Semigroup)\n\n\ninstance IsList QueryData where\n  type Item QueryData = (Param, ParamValue)\n  fromList = QueryData . fromList\n  toList (QueryData m) = toList m\n\n\nsingleton :: (ToParam a) => Param -> a -> QueryData\nsingleton key a = QueryData $ M.singleton key (toParam a)\n\n\ninsert :: (ToParam a) => Param -> a -> QueryData -> QueryData\ninsert p a (QueryData m) =\n  QueryData $ M.insert p (toParam a) m\n\n\ninsertAll :: (ToQuery a) => a -> QueryData -> QueryData\ninsertAll a (QueryData m) =\n  let QueryData kvs = toQuery a\n   in QueryData $ M.union kvs m\n\n\ndelete :: Param -> QueryData -> QueryData\ndelete p (QueryData m) =\n  QueryData $ M.delete p m\n\n\nlookup :: (FromParam a) => Param -> QueryData -> Maybe a\nlookup k (QueryData m) = do\n  t <- M.lookup k m\n  either (const Nothing) pure $ parseParam t\n\n\nrequire :: (FromParam a) => Param -> QueryData -> Either String a\nrequire p (QueryData m) = do\n  case M.lookup p m of\n    Nothing -> Left $ \"Missing Key: \" <> cs p.text\n    Just val -> parseParam val\n\n\nfilterKey :: (Param -> Bool) -> QueryData -> QueryData\nfilterKey p (QueryData m) =\n  QueryData $ M.filterWithKey (\\k _ -> p k) m\n\n\nmember :: Param -> QueryData -> Bool\nmember k (QueryData qd) = M.member k qd\n\n\nelems :: QueryData -> [ParamValue]\nelems (QueryData m) = M.elems m\n\n\nrender :: QueryData -> ByteString\nrender qd =\n  renderQuery False (HTTP.toQuery $ fromQueryData qd)\n\n\nparse :: ByteString -> QueryData\nparse =\n  -- urlDecode True\n  queryData . HTTP.parseQuery\n\n\nqueryData :: Query -> QueryData\nqueryData q =\n  fromList $ fmap fromQueryItem q\n where\n  fromQueryItem :: QueryItem -> (Param, ParamValue)\n  fromQueryItem (key, mval) =\n    (Param (cs key), fromParam mval)\n\n  fromParam :: Maybe ByteString -> ParamValue\n  fromParam Nothing = jsonParam Null\n  fromParam (Just t) = decodeParam (cs t)\n\n\nfromQueryData :: QueryData -> Query\nfromQueryData q =\n  fmap toQueryItem $ toList q\n where\n  toQueryItem :: (Param, ParamValue) -> QueryItem\n  toQueryItem (Param prm, pval) =\n    (cs prm, Just $ toQueryValue pval)\n\n  toQueryValue :: ParamValue -> ByteString\n  toQueryValue = cs . encodeParam\n\n\n{- | Decode a type from a 'QueryData'. Missing fields are set to 'Data.Default.def'\n\n@\n#EMBED Example.Docs.Encoding data Filters\n@\n\n>>> parseQuery $ QueryData.parse \"active=true&search=asdf\"\nRight (Filters True \"asdf\")\n\n>>> parseQuery $ QueryData.parse \"search=asdf\"\nRight (Filters False \"asdf\")\n-}\nclass FromQuery a where\n  parseQuery :: QueryData -> Either String a\n  default parseQuery :: (Generic a, GFromQuery (Rep a)) => QueryData -> Either String a\n  parseQuery q = to <$> gParseQuery q\n\n\ninstance FromQuery QueryData where\n  parseQuery = pure\n\n\n{- | A page can store state in the browser 'query' string. ToQuery and 'FromQuery' control how a datatype is encoded to a full query string\n\n@\n#EMBED Example.Docs.Encoding data Filters\n@\n\n>>> QueryData.render $ toQuery $ Filter True \"asdf\"\n\"active=true&search=asdf\"\n\nIf the value of a field is the same as 'Default', it will be omitted from the query string\n\n>>> QueryData.render $ toQuery $ Filter True \"\"\n\"active=true\"\n\n>>> QueryData.render $ toQuery $ Filter False \"\"\n\"\"\n-}\nclass ToQuery a where\n  toQuery :: a -> QueryData\n  default toQuery :: (Generic a, GToQuery (Rep a)) => a -> QueryData\n  toQuery = gToQuery . from\n\n\ninstance ToQuery QueryData where\n  toQuery = id\n\n\ninstance ToQuery Query where\n  toQuery = queryData\n\n\n-- | Generic decoding of records from a Query\nclass GFromQuery f where\n  gParseQuery :: QueryData -> Either String (f p)\n\n\ninstance (GFromQuery f, GFromQuery g) => GFromQuery (f :*: g) where\n  gParseQuery q = do\n    a <- gParseQuery q\n    b <- gParseQuery q\n    pure $ a :*: b\n\n\ninstance (GFromQuery f) => GFromQuery (M1 D d f) where\n  gParseQuery q = M1 <$> gParseQuery q\n\n\ninstance (GFromQuery f) => GFromQuery (M1 C c f) where\n  gParseQuery q = M1 <$> gParseQuery q\n\n\ninstance {-# OVERLAPPABLE #-} (Selector s, FromParam a, Default a) => GFromQuery (M1 S s (K1 R a)) where\n  gParseQuery q = do\n    let s = selName (undefined :: M1 S s (K1 R (f a)) p)\n    let mval = lookup (Param $ pack s) q\n    pure $ M1 $ K1 $ fromMaybe def mval\n\n\n-- Text doesn't have a default instance. Annoying\ninstance {-# OVERLAPS #-} (Selector s) => GFromQuery (M1 S s (K1 R Text)) where\n  gParseQuery q = do\n    let s = selName (undefined :: M1 S s (K1 R (f a)) p)\n    let mval = lookup (Param $ pack s) q\n    pure $ M1 $ K1 $ fromMaybe \"\" mval\n\n\n-- | Generic encoding of records to a Query\nclass GToQuery f where\n  gToQuery :: f p -> QueryData\n\n\ninstance (GToQuery f, GToQuery g) => GToQuery (f :*: g) where\n  gToQuery (f :*: g) = gToQuery f <> gToQuery g\n\n\ninstance (GToQuery f) => GToQuery (M1 D d f) where\n  gToQuery (M1 f) = gToQuery f\n\n\ninstance (GToQuery f) => GToQuery (M1 C d f) where\n  gToQuery (M1 f) = gToQuery f\n\n\ninstance {-# OVERLAPPABLE #-} (Selector s, ToParam a, Eq a, Default a) => GToQuery (M1 S s (K1 R a)) where\n  gToQuery (M1 (K1 a))\n    | a == def = mempty\n    | otherwise =\n        let sel = Param $ pack $ selName (undefined :: M1 S s (K1 R (f a)) p)\n         in singleton sel a\n\n\n-- Special case for Text, which has no Default instance\ninstance {-# OVERLAPS #-} (Selector s) => GToQuery (M1 S s (K1 R Text)) where\n  gToQuery (M1 (K1 a))\n    | a == \"\" = mempty\n    | otherwise =\n        let sel = Param $ pack $ selName (undefined :: M1 S s (K1 R (f a)) p)\n         in singleton sel a\n\n-- instance {-# OVERLAPS #-} (Selector s, ToParam a, Eq a) => GToQuery (M1 S s (K1 R [a])) where\n--   gToQuery (M1 (K1 a))\n--     | a == [] = mempty\n--     | otherwise =\n--         let sel = Param $ pack $ selName (undefined :: M1 S s (K1 R (f a)) p)\n--          in singleton sel $ Plusses a\n"
  },
  {
    "path": "src/Web/Hyperbole/Data/URI.hs",
    "content": "module Web.Hyperbole.Data.URI\n  ( -- * URI\n    URI (..)\n  , URIAuth (..)\n  , uri\n\n    -- ** Path\n  , Path (..)\n  , Segment\n  , path\n  , parseURIReference\n  , pathUri\n  , uriToText\n  , pathToText\n\n    -- ** Query String\n  , queryString\n  , parseQuery\n  , queryInsert\n  , renderQuery\n  , Query\n  , QueryItem\n  , (./.)\n  , (.?.)\n  , cleanSegment\n  , Endpoint (..)\n  )\nwhere\n\nimport Data.ByteString (ByteString)\nimport Data.String (IsString (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport GHC.Exts (IsList (..))\nimport Network.HTTP.Types (Query, QueryItem, parseQuery, renderQuery)\nimport Network.URI (URI (..), URIAuth (..), parseURIReference, uriToString)\nimport Network.URI qualified as Network\nimport Network.URI.Static (uri)\nimport System.FilePath (normalise, (</>))\n\n\n-- Constructors ------------------------------------------\n-- see `uri` for static URIs\n\n-- Operators -----------------------------------------------\n\n-- maybe lets not care about leading slashes at all until rendering\n(./.) :: URI -> Path -> URI\nu ./. p =\n  u{Network.uriPath = addLeadingSlash $ normalise (u.uriPath </> newPath)}\n where\n  newPath = cs $ pathToText False p\n\n  addLeadingSlash pth =\n    case take 1 pth of\n      \"/\" -> pth\n      _ -> '/' : pth\n\n\ninfixl 5 ./.\n\n\n(.?.) :: URI -> QueryItem -> URI\nu .?. (k, mv) = u{uriQuery = queryInsert k mv u.uriQuery}\n\n\n-- Query ---------------------------------------------------\n\ntype QueryString = String\n\n\nqueryInsert :: ByteString -> Maybe ByteString -> QueryString -> QueryString\nqueryInsert k mv s =\n  queryString $ parseQuery (cs s) <> [(k, mv)]\n\n\nqueryString :: [(ByteString, Maybe ByteString)] -> QueryString\nqueryString = cs . renderQuery True\n\n\n-- Path -----------------------------------------------------\n\nnewtype Path = Path {segments :: [Segment]}\n  deriving (Show, Eq)\ninstance IsList Path where\n  type Item Path = Segment\n  fromList = Path . filter (not . T.null)\n  toList p = p.segments\ninstance IsString Path where\n  fromString = path . cs\n\n\ntype Segment = Text\n\n\ncleanSegment :: Segment -> Segment\ncleanSegment = T.dropWhileEnd (== '/') . T.dropWhile (== '/')\n\n\npath :: Text -> Path\npath p =\n  fromList $ T.splitOn \"/\" $ T.dropWhile (== '/') p\n\n\npathUri :: Path -> URI\npathUri p =\n  URI\n    { uriPath = cs $ pathToText True p\n    , uriScheme = mempty\n    , uriAuthority = Nothing\n    , uriQuery = mempty\n    , uriFragment = mempty\n    }\n\n\nuriToText :: URI -> Text\nuriToText u = cs $ uriToString id u \"\"\n\n\npathToText :: Bool -> Path -> Text\npathToText isRoot p =\n  pathPrefix <> T.intercalate \"/\" (fmap cleanSegment p.segments)\n where\n  pathPrefix :: Text\n  pathPrefix =\n    if isRoot then \"/\" else \"\"\n\n\n-- | A URI with a phantom type to distinguish different endpoints\nnewtype Endpoint a = Endpoint {uri :: URI}\n"
  },
  {
    "path": "src/Web/Hyperbole/Document.hs",
    "content": "{-# LANGUAGE QuasiQuotes #-}\n\nmodule Web.Hyperbole.Document where\n\nimport Data.ByteString.Lazy qualified as BL\nimport Data.String.Interpolate (i)\nimport GHC.Generics (Generic)\nimport Web.Hyperbole.View\n\n\ndata Document = Document\n\n\n{- | 'liveApp' requires a function which turns an html fragment into an entire html document. Use this to import javascript, css, etc. Use 'quickStartDocument' to get going quickly\n\n> #EMBED Example.Docs.App app\n-}\ndocument :: View DocumentHead () -> BL.ByteString -> BL.ByteString\ndocument docHead cnt =\n  [i|<!doctype html>\n  <html>\n  <head>\n    <meta charset=\"UTF-8\"/>\n    #{renderLazyByteString $ runViewContext DocumentHead () docHead}\n  </head>\n  <body>\n    #{cnt}\n  </body>\n</html>|]\n\n\n{- | Create a custom \\<head\\> to use with 'document'. Remember to include at least `scriptEmbed`!\n\n> import Web.Hyperbole (scriptEmbed, cssEmbed)\n>\n> #EMBED Example.Docs.App documentHead\n>\n> #EMBED Example.Docs.App app\n-}\ndata DocumentHead = DocumentHead\n  deriving (Generic, ViewId)\n\n\n{- | A simple mobile-friendly document with all required embeds and live reload\n\n@\n'liveApp' quickStartDocument ('routeRequest' router)\n@\n-}\nquickStartDocument :: BL.ByteString -> BL.ByteString\nquickStartDocument = document (mobileFriendly >> quickStart)\n\n\n-- | A simple mobile-friendly header with all required embeds and live reload\nquickStart :: View DocumentHead ()\nquickStart = do\n  mobileFriendly\n  style cssEmbed\n  script' scriptEmbed\n  script' scriptLiveReload\n\n\n-- | Set the viewport to handle mobile zoom\nmobileFriendly :: View DocumentHead ()\nmobileFriendly = do\n  meta @ name \"viewport\" . content \"width=device-width, initial-scale=1.0\"\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Client.hs",
    "content": "module Web.Hyperbole.Effect.Client where\n\nimport Data.Aeson\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Reader.Dynamic\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.HyperView\nimport Web.Hyperbole.Types.Client (clientSetPageTitle)\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.View (toAction, toViewId)\n\n\n{- | Trigger an action for an arbitrary 'HyperView'\n\n@\n#EMBED Example.Trigger instance HyperView Controls\n@\n-}\ntrigger :: (HyperView id es, HyperViewHandled id view, Hyperbole :> es) => id -> Action id -> Eff (Reader view : es) ()\ntrigger vid act = do\n  send $ PushTrigger (TargetViewId $ toViewId vid) (toAction act)\n\n\n{- | Dispatch a custom javascript event. This is emitted on the current hyper view and bubbles up to the document\n\n@\n#EMBED Example.Javascript instance HyperView Message\n@\n\n@\nfunction listenServerEvents() {\n  // you can listen on document instead, the event will bubble\n  Hyperbole.hyperView(\"Message\").addEventListener(\"server-message\", function(e) {\n    alert(\"Server Message: \" + e.detail)\n  })\n}\n@\n-}\npushEvent :: (ToJSON a, Hyperbole :> es) => Text -> a -> Eff es ()\npushEvent nm a = do\n  send $ PushEvent nm (toJSON a)\n\n\n{- | Set the document title\n\n@\n#EMBED Example.Docs.Client page\n@\n-}\npageTitle :: (Hyperbole :> es) => Text -> Eff es ()\npageTitle t = do\n  send $ ModClient $ clientSetPageTitle t\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/GenRandom.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Effect.GenRandom where\n\nimport Control.Monad (replicateM)\nimport Data.Aeson (FromJSON, ToJSON)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport System.Random (Random, randomRIO)\nimport Web.Hyperbole.Data.Param (FromParam, ToParam)\n\n\ndata GenRandom :: Effect where\n  GenRandom :: (Random a) => (a, a) -> GenRandom m a\n  GenRandomToken :: Int -> GenRandom m (Token a)\n  GenRandomList :: (Random a) => [a] -> GenRandom m a\n\n\ntype instance DispatchOf GenRandom = 'Dynamic\n\n\nrunRandom\n  :: (IOE :> es)\n  => Eff (GenRandom : es) a\n  -> Eff es a\nrunRandom = interpret $ \\_ -> \\case\n  GenRandom range -> liftIO $ randomRIO range\n  GenRandomToken n -> do\n    let chars = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']\n    randStr <- liftIO $ replicateM n (randomFromList chars)\n    pure $ Token $ cs randStr\n  GenRandomList as ->\n    liftIO $ randomFromList as\n where\n  randomFromList :: (Random a) => [a] -> IO a\n  randomFromList as = do\n    index <- liftIO $ randomRIO (0, length as - 1)\n    pure $ as !! index\n\n\ngenRandom :: (Random a, GenRandom :> es) => (a, a) -> Eff es a\ngenRandom range = send $ GenRandom range\n\n\ngenRandomToken :: (GenRandom :> es) => Int -> Eff es (Token a)\ngenRandomToken num = send $ GenRandomToken num\n\n\ngenRandomList :: (Random a, GenRandom :> es) => [a] -> Eff es a\ngenRandomList as = send $ GenRandomList as\n\n\nnewtype Token a = Token {value :: Text}\n  deriving newtype (FromJSON, ToJSON, FromParam, ToParam, Eq, Show, Read, Ord)\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Hyperbole.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.Effect.Hyperbole where\n\nimport Data.Aeson (Value)\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Error.Static\nimport Effectful.State.Static.Local\nimport Effectful.Writer.Static.Local\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Types.Client\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\n\n\n-- | The 'Hyperbole' 'Effect' allows you to access information in the 'Request', manually respond, and manipulate the Client 'session' and 'query'.\ndata Hyperbole :: Effect where\n  GetRequest :: Hyperbole m Request\n  RespondNow :: Response -> Hyperbole m a\n  PushUpdate :: ViewUpdate -> Hyperbole m ()\n  ModClient :: (Client -> Client) -> Hyperbole m ()\n  GetClient :: Hyperbole m Client\n  PushTrigger :: TargetViewId -> Encoded -> Hyperbole m ()\n  PushEvent :: Text -> Value -> Hyperbole m ()\n\n\ntype instance DispatchOf Hyperbole = 'Dynamic\n\n\ndata Remote\n  = RemoteAction TargetViewId Encoded\n  | RemoteEvent Text Value\n\n\nrunHyperboleLocal :: Request -> Eff (Error Response : State Client : Writer [Remote] : es) Response -> Eff es (Response, Client, [Remote])\nrunHyperboleLocal req eff = do\n  ((eresp, client'), rmts) <- runWriter @[Remote] . runState (emptyClient req.requestId) . runErrorNoCallStack @Response $ eff\n  pure (either id id eresp, client', rmts)\n where\n  emptyClient :: RequestId -> Client\n  emptyClient requestId =\n    Client\n      { requestId\n      , session = mempty\n      , query = mempty\n      , pageTitle = Nothing\n      }\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/OAuth2.hs",
    "content": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Effect.OAuth2\n  ( OAuth2 (..)\n  , authUrl\n  , validateCode\n  , exchangeAuth\n  , exchangeRefresh\n  , runOAuth2\n  , getConfigEnv\n  , Scopes (..)\n  , AuthFlow (..)\n  , Config (..)\n  , TokenType (..)\n  , Authenticated (..)\n  , Token (..)\n  , ClientId\n  , ClientSecret\n  , Code\n  , Access\n  , Refresh\n  , State\n  , Auth\n  , OAuth2Error (..)\n  ) where\n\nimport Control.Monad (unless, when)\nimport Data.Aeson (FromJSON (..), Options (..), ToJSON (..), Value (..), defaultOptions, eitherDecode, genericParseJSON, genericToJSON)\nimport Data.ByteString.Lazy qualified as BL\nimport Data.Default\nimport Data.Maybe (isJust)\nimport Data.String (IsString (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Environment\nimport Effectful.Exception\nimport GHC.Generics (Generic)\nimport Network.HTTP.Client (HttpException, Request (..), RequestBody (..))\nimport Network.HTTP.Client qualified as HTTP\nimport Network.HTTP.Types (hAccept, hContentType)\nimport Network.URI (parseURI)\nimport Text.Casing (quietSnake)\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.Param\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.Effect.GenRandom\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Effect.Query\nimport Web.Hyperbole.Effect.Response (respondError)\nimport Web.Hyperbole.Effect.Session (Session (..), deleteSession, saveSession, session)\nimport Web.Hyperbole.Types.Response\n\n\nauthUrl :: (OAuth2 :> es) => URI -> Scopes -> Eff es URI\nauthUrl redirectUrl scopes = send $ AuthUrl redirectUrl scopes\n\n\nvalidateCode :: (OAuth2 :> es) => Eff es (Token Code)\nvalidateCode = send ValidateCode\n\n\nexchangeAuth :: (OAuth2 :> es) => Token Code -> Eff es Authenticated\nexchangeAuth authCode = send $ ExchangeAuth authCode\n\n\nexchangeRefresh :: (OAuth2 :> es) => Token Refresh -> Eff es Authenticated\nexchangeRefresh refToken = send $ ExchangeRefresh refToken\n\n\ndata OAuth2 :: Effect where\n  AuthUrl :: URI -> Scopes -> OAuth2 m URI\n  ValidateCode :: OAuth2 m (Token Code)\n  ExchangeAuth :: Token Code -> OAuth2 m Authenticated\n  ExchangeRefresh :: Token Refresh -> OAuth2 m Authenticated\n\n\ntype instance DispatchOf OAuth2 = 'Dynamic\n\n\nrunOAuth2\n  :: (GenRandom :> es, IOE :> es, Hyperbole :> es)\n  => Config\n  -> HTTP.Manager\n  -> Eff (OAuth2 : es) a\n  -> Eff es a\nrunOAuth2 cfg mgr = interpret $ \\_ -> \\case\n  AuthUrl red scopes -> do\n    state <- genRandomToken 6\n    let url = authorizationUrl cfg.authorize cfg.clientId red scopes state\n    saveSession $ AuthFlow red state\n    pure url\n  ValidateCode -> do\n    flow <- session @AuthFlow\n    validateRedirectParams flow\n  ExchangeAuth authCode -> do\n    flow <- session @AuthFlow\n    let params = tokenParams cfg.clientId cfg.clientSecret flow.redirect authCode\n    auth <- sendTokenRequest cfg mgr params\n    deleteSession @AuthFlow\n    pure auth\n  ExchangeRefresh refToken -> do\n    let params = refreshParams cfg.clientId cfg.clientSecret refToken\n    sendTokenRequest cfg mgr params\n\n\n{- | read oauth config from env. This is not required, you can obtain these secrets another way\nand configure the app however you please. Just pass the results into runOAuth2 in your app\n-}\ngetConfigEnv :: (Environment :> es) => Eff es Config\ngetConfigEnv = do\n  clientId <- Token . cs <$> getEnv \"OAUTH2_CLIENT_ID\"\n  clientSecret <- Token . cs <$> getEnv \"OAUTH2_CLIENT_SECRET\"\n  authorize <- Endpoint <$> getEnvURI \"OAUTH2_AUTHORIZE_ENDPOINT\"\n  token <- Endpoint <$> getEnvURI \"OAUTH2_TOKEN_ENDPOINT\"\n  pure $ Config{clientId, clientSecret, authorize, token}\n where\n  getEnvURI n = do\n    str <- getEnv n\n    case parseURI str of\n      Nothing -> throwIO $ OAuth2BadEnv n str\n      Just u -> pure u\n\n\n-- Types -------------------------------------------------\n\nnewtype Scopes = Scopes [Text]\n  deriving (Show, Generic)\n  deriving anyclass (FromParam, ToParam)\ninstance ToJSON Scopes where\n  toJSON (Scopes ss) = String $ T.unwords ss\ninstance FromJSON Scopes where\n  parseJSON v = do\n    t <- parseJSON @String v\n    pure $ fromString t\ninstance IsString Scopes where\n  fromString s = Scopes $ T.words $ cs s\n\n\ndata ClientId\ndata ClientSecret\ndata Code\ndata Refresh\ndata Access\ndata State\ndata Auth\n\n#if (!MIN_VERSION_aeson(2,2,0))\ninstance FromJSON URI\ninstance ToJSON URI\ninstance FromJSON URIAuth\ninstance ToJSON URIAuth\n#endif\n\n\ndata AuthFlow = AuthFlow\n  { redirect :: URI\n  , state :: Token State\n  }\n  deriving (Generic, FromEncoded, ToEncoded)\ninstance Session AuthFlow where\n  sessionKey = \"OAuth2AuthFlow\"\n  cookiePath = Just \"/\"\ninstance Default AuthFlow where\n  def = AuthFlow (pathUri \"/\") (Token mempty)\n\n\ndata Config = Config\n  { clientId :: Token ClientId\n  , clientSecret :: Token ClientSecret\n  , authorize :: Endpoint Auth\n  , token :: Endpoint (Token ())\n  }\n\n\ndata TokenType\n  = Bearer\n  deriving (Show, Read, Generic, ToParam, FromParam)\ninstance ToJSON TokenType where\n  toJSON s = toJSON $ show s\ninstance FromJSON TokenType where\n  parseJSON (String ttyp) | T.toLower ttyp == \"bearer\" = pure Bearer\n  parseJSON val = fail $ \"expected TokenType but got \" <> show val\n\n\ndata Authenticated = Authenticated\n  { tokenType :: TokenType\n  , expiresIn :: Maybe Int\n  , scope :: Maybe Scopes\n  , accessToken :: Token Access\n  , refreshToken :: Maybe (Token Refresh)\n  }\n  deriving (Generic, Show, ToParam, FromParam, ToEncoded, FromEncoded)\ninstance FromJSON Authenticated where\n  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = quietSnake}\ninstance ToJSON Authenticated where\n  toJSON = genericToJSON defaultOptions{fieldLabelModifier = quietSnake}\ninstance Session Authenticated where\n  sessionKey = \"OAuth2Authenticated\"\n  cookiePath = Just \"/\"\n\n\ndata OAuth2Error\n  = OAuth2BadResponse String BL.ByteString\n  | OAuth2TokenRequest HttpException\n  | OAuth2BadEnv String String\n  deriving (Show, Exception)\n\n\n-- Lower level --------------------------------------------------\n\nauthorizationUrl :: Endpoint Auth -> Token ClientId -> URI -> Scopes -> Token State -> URI\nauthorizationUrl (Endpoint auth) (Token cid) redUrl (Scopes scopes) (Token state) =\n  auth{uriQuery = cs $ renderQuery True authParams}\n where\n  authParams =\n    [ (\"response_type\", Just \"code\")\n    , (\"client_id\", Just $ cs cid)\n    , (\"redirect_uri\", Just $ cs $ uriToText redUrl)\n    , (\"scope\", Just $ cs $ T.intercalate \" \" scopes)\n    , (\"state\", Just $ cs state)\n    ]\n\n\ntokenParams :: Token ClientId -> Token ClientSecret -> URI -> Token Code -> Query\ntokenParams (Token cid) (Token sec) redUrl (Token ac) =\n  [ (\"grant_type\", Just \"authorization_code\")\n  , (\"client_id\", Just $ cs cid)\n  , (\"client_secret\", Just $ cs sec)\n  , (\"redirect_uri\", Just $ cs $ uriToText redUrl)\n  , (\"code\", Just $ cs ac)\n  ]\n\n\nrefreshParams :: Token ClientId -> Token ClientSecret -> Token Refresh -> Query\nrefreshParams (Token cid) (Token sec) (Token ref) =\n  [ (\"grant_type\", Just \"refresh_token\")\n  , (\"client_id\", Just $ cs cid)\n  , (\"client_secret\", Just $ cs sec)\n  , (\"refresh_token\", Just $ cs ref)\n  ]\n\n\nvalidateRedirectParams :: (Hyperbole :> es) => AuthFlow -> Eff es (Token Code)\nvalidateRedirectParams flow = do\n  err <- lookupParam @Text \"error\"\n\n  when (isJust err) $ do\n    desc <- param \"error_description\"\n    respondError $ ErrAuth desc\n\n  authState <- param @(Token State) \"state\"\n  authCode <- param @(Token Code) \"code\"\n\n  unless (flow.state == authState) $ do\n    respondError $ ErrAuth \"Oauth2 State mismatch\"\n\n  pure authCode\n\n\nsendTokenRequest :: (IOE :> es) => Config -> HTTP.Manager -> Query -> Eff es Authenticated\nsendTokenRequest cfg mgr params = do\n  baseReq <- HTTP.requestFromURI cfg.token.uri\n\n  let req =\n        baseReq\n          { method = \"POST\"\n          , requestBody = RequestBodyBS $ renderQuery False params\n          , requestHeaders =\n              [ (hContentType, \"application/x-www-form-urlencoded\")\n              , (hAccept, \"application/json\")\n              ]\n          }\n\n  res <- liftIO (HTTP.httpLbs req mgr) `catch` (throwIO . OAuth2TokenRequest)\n\n  let body = HTTP.responseBody res\n  case eitherDecode @Authenticated body of\n    Left e -> throwIO $ OAuth2BadResponse e body\n    Right tr -> pure tr\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Query.hs",
    "content": "module Web.Hyperbole.Effect.Query where\n\nimport Data.ByteString qualified as BS\nimport Data.Default (Default (..))\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Effectful\nimport Effectful.Dispatch.Dynamic (send)\nimport Web.Hyperbole.Data.Param (FromParam (..), Param, ToParam (..))\nimport Web.Hyperbole.Data.QueryData (FromQuery (..), QueryData (..), ToQuery (..), queryData)\nimport Web.Hyperbole.Data.QueryData qualified as QueryData\nimport Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))\nimport Web.Hyperbole.Effect.Request (request)\nimport Web.Hyperbole.Types.Client (Client (..), clientSetQuery)\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\nimport Prelude\n\n\n{- | Parse querystring from the 'Request' into a datatype. See 'FromQuery'\n\n@\n#EMBED Example.Docs.Params data Filters\n\n#EMBED Example.Docs.Params page\n@\n-}\nquery :: (FromQuery a, Hyperbole :> es) => Eff es a\nquery = do\n  q <- queryParams\n  case parseQuery q of\n    Left e -> send $ RespondNow $ Err $ ErrQuery $ \"Query Parse \" <> e <> \" from \" <> cs (show q)\n    Right a -> pure a\n\n\n{- | Update the client's querystring to an encoded datatype. See 'ToQuery'\n\n@\n#EMBED Example.Docs.Params instance HyperView Todos\n@\n-}\nsetQuery :: (ToQuery a, Hyperbole :> es) => a -> Eff es ()\nsetQuery a = do\n  modifyQueryData (const $ toQuery a)\n\n\nmodifyQuery :: (ToQuery a, FromQuery a, Default a, Hyperbole :> es) => (a -> a) -> Eff es a\nmodifyQuery f = do\n  s <- query\n  let updated = f s\n  setQuery updated\n  pure updated\n\n\nclearQuery :: (Hyperbole :> es) => Eff es ()\nclearQuery =\n  setQuery (mempty :: QueryData)\n\n\n{- | Parse a single query parameter. Return a 400 status if missing or if parsing fails. See 'FromParam'\n\n@\n#EMBED Example.Docs.Params page'\n@\n-}\nparam :: (FromParam a, Hyperbole :> es) => Param -> Eff es a\nparam p = do\n  q <- queryParams\n  case QueryData.require p q of\n    Left e -> send $ RespondNow $ Err $ ErrQuery (cs e)\n    Right a -> pure a\n\n\n{- | Parse a single parameter from the query string if available\n\n\n@\n#EMBED Example.Docs.SideEffects page\n@\n-}\nlookupParam :: (FromParam a, Hyperbole :> es) => Param -> Eff es (Maybe a)\nlookupParam p = do\n  QueryData.lookup p <$> queryParams\n\n\n{- | Modify the client's querystring to set a single parameter. See 'ToParam'\n\n@\n#EMBED Example.Docs.Params instance HyperView Message\n@\n-}\nsetParam :: (ToParam a, Hyperbole :> es) => Param -> a -> Eff es ()\nsetParam key a = do\n  modifyQueryData (QueryData.insert key a)\n\n\n-- | Delete a single parameter from the query string\ndeleteParam :: (Hyperbole :> es) => Param -> Eff es ()\ndeleteParam key = do\n  modifyQueryData (QueryData.delete key)\n\n\n-- | Return the querystring from 'Request' as a 'QueryData'\nqueryParams :: (Hyperbole :> es) => Eff es QueryData\nqueryParams = do\n  cq <- clientQuery\n  rq <- requestQuery\n  pure $ fromMaybe rq cq\n where\n  clientQuery = (.query) <$> send GetClient\n\n  requestQuery :: (Hyperbole :> es) => Eff es QueryData\n  requestQuery = do\n    r <- request\n    pure $ queryData $ filter (not . isSystemParam) r.query\n\n  isSystemParam (key, _) =\n    \"hyp-\" `BS.isPrefixOf` key\n\n\nmodifyQueryData :: (Hyperbole :> es) => (QueryData -> QueryData) -> Eff es ()\nmodifyQueryData f = do\n  q <- queryParams\n  send $ ModClient $ clientSetQuery (f q)\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Request.hs",
    "content": "module Web.Hyperbole.Effect.Request where\n\nimport Data.String.Conversions (cs)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Web.FormUrlEncoded (Form, urlDecodeForm)\nimport Web.Hyperbole.Data.URI (Path (..))\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\n\n\n-- | Return all information about the 'Request'\nrequest :: (Hyperbole :> es) => Eff es Request\nrequest = send GetRequest\n\n\n{- | Return the request path\n\n>>> reqPath\n[\"users\", \"100\"]\n-}\nreqPath :: (Hyperbole :> es) => Eff es Path\nreqPath = (.path) <$> request\n\n\n{- | Return the request body as a Web.FormUrlEncoded.Form\n\nPrefer using Type-Safe 'Form's when possible\n-}\nformBody :: (Hyperbole :> es) => Eff es Form\nformBody = do\n  b <- (.body) <$> request\n  let ef = urlDecodeForm b\n  either (send . RespondNow . Err . ErrParse . cs) pure ef\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Response.hs",
    "content": "module Web.Hyperbole.Effect.Response where\n\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Dynamic\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))\nimport Web.Hyperbole.HyperView (ConcurrencyValue (..), HyperView (..), hyperUnsafe)\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.Types.Response\nimport Web.Hyperbole.View\n\n\n-- | Respond with the given hyperview\nhyperView :: (HyperView id es, ToEncoded (ViewState id)) => id -> ViewState id -> View id () -> Eff es Response\nhyperView i st vw = do\n  let vid = TargetViewId (toViewId i)\n  pure $ Response $ ViewUpdate vid $ renderBody $ hyperUnsafe i st vw\n\n\npushUpdate :: (Hyperbole :> es, ViewId id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id)) => View id () -> Eff (Reader id : State (ViewState id) : es) ()\npushUpdate vw = do\n  i <- viewId\n  st <- get\n  pushUpdateTo i st vw\n\n\npushUpdateTo :: (Hyperbole :> es, ViewId id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id)) => id -> ViewState id -> View id () -> Eff es ()\npushUpdateTo i st vw = do\n  send $ PushUpdate $ ViewUpdate (TargetViewId $ toViewId i) $ renderBody $ hyperUnsafe i st vw\n\n\n-- | Abort execution and respond with an error\nrespondError :: (Hyperbole :> es) => ResponseError -> Eff es a\nrespondError err = do\n  send $ RespondNow $ Err err\n\n\n-- | Abort execution and respond with an error view\nrespondErrorView :: (Hyperbole :> es) => Text -> View () () -> Eff es a\nrespondErrorView msg vw = do\n  send $ RespondNow $ Err $ ErrCustom $ ServerError msg $ renderBody vw\n\n\n{- | Abort execution and respond with 404 Not Found\n\n@\n#EMBED Example.Docs.App findUser\n\n#EMBED Example.Docs.App userPage\n@\n-}\nnotFound :: (Hyperbole :> es) => Eff es a\nnotFound = send $ RespondNow $ Err NotFound\n\n\n-- | Respond immediately with a parse error\nparseError :: (Hyperbole :> es) => String -> Eff es a\nparseError = respondError . ErrParse\n\n\n-- | Abort execution and redirect to a 'URI'\nredirect :: (Hyperbole :> es) => URI -> Eff es a\nredirect = send . RespondNow . Redirect\n\n\n-- | Respond with a generic view. Normally you will return a view from the page or handler instead of using this function\nview :: View () () -> Response\nview v =\n  Response $ ViewUpdate (TargetViewId mempty) (renderBody v)\n"
  },
  {
    "path": "src/Web/Hyperbole/Effect/Session.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DefaultSignatures #-}\n\nmodule Web.Hyperbole.Effect.Session where\n\nimport Data.Default (Default (..))\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport GHC.Generics\nimport Web.Hyperbole.Data.Cookie as Cookie\nimport Web.Hyperbole.Data.Encoded as Encoded\nimport Web.Hyperbole.Data.Param\nimport Web.Hyperbole.Data.URI (Path)\nimport Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))\nimport Web.Hyperbole.Effect.Request (request)\nimport Web.Hyperbole.Types.Client (Client (..), clientModCookies)\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\n\n\n{- | Configure a data type to persist in the 'session' as a cookie. These are type-indexed, so only one of each can exist in the session\n\n@\n#EMBED Example.Docs.Sessions data Preferences\n\n#EMBED Example.Docs.Sessions instance Default Preferences\n@\n-}\nclass Session a where\n  -- | Unique key for this Session Type. Defaults to the datatypeName\n  sessionKey :: Key\n  default sessionKey :: (Generic a, GDatatypeName (Rep a)) => Key\n  sessionKey = gDatatypeName $ from (undefined :: a)\n\n\n  -- | By default Sessions are persisted only to the current page. Set to `Just \"/\"` to make an instance available application-wide\n  cookiePath :: Maybe Path\n  default cookiePath :: Maybe Path\n  cookiePath = Nothing\n\n\n  -- | By default cookies are secure (HTTPS only). Set to False for local development or LAN usage\n  cookieSecure :: Bool\n  default cookieSecure :: Bool\n  cookieSecure = True\n\n\n  -- | Encode type to a a cookie value\n  toCookie :: a -> CookieValue\n  default toCookie :: (ToEncoded a) => a -> CookieValue\n  toCookie = CookieValue . cs . Encoded.encode\n\n\n  -- | Decode from a cookie value. Defaults to FromJSON\n  parseCookie :: CookieValue -> Either String a\n  default parseCookie :: (FromEncoded a) => CookieValue -> Either String a\n  parseCookie (CookieValue bs) = do\n    Encoded.decodeEither (cs bs)\n\n\n{- | Load data from a browser cookie. If it doesn't exist, the 'Default' instance is used\n\n@\n#EMBED Example.Docs.Sessions data Preferences\n\n#EMBED Example.Docs.Sessions instance Default Preferences\n\n#EMBED Example.Docs.Sessions page\n@\n-}\nsession :: (Session a, Default a, Hyperbole :> es) => Eff es a\nsession = do\n  ms <- lookupSession\n  pure $ fromMaybe def ms\n\n\n-- | Return a session if it exists\nlookupSession :: forall a es. (Session a, Hyperbole :> es) => Eff es (Maybe a)\nlookupSession = do\n  let key = sessionKey @a\n  mck <- Cookie.lookup key <$> sessionCookies\n  case mck of\n    Nothing -> pure Nothing\n    Just val -> Just <$> parseSession key val\n\n\n{- | Persist datatypes in browser cookies\n\n@\n#EMBED Example.Docs.Sessions data Preferences\n\n#EMBED Example.Docs.Sessions instance Default Preferences\n\n#EMBED Example.Docs.Sessions instance HyperView Content\n@\n-}\nsaveSession :: forall a es. (Session a, Hyperbole :> es) => a -> Eff es ()\nsaveSession a = do\n  modifyCookies $ Cookie.insert $ sessionCookie a\n\n\nmodifySession :: (Session a, Default a, Hyperbole :> es) => (a -> a) -> Eff es a\nmodifySession f = do\n  s <- session\n  let updated = f s\n  saveSession updated\n  pure updated\n\n\nmodifySession_ :: (Session a, Default a, Hyperbole :> es) => (a -> a) -> Eff es ()\nmodifySession_ f = do\n  _ <- modifySession f\n  pure ()\n\n\n-- | Remove a single 'Session' from the browser cookies\ndeleteSession :: forall a es. (Session a, Hyperbole :> es) => Eff es ()\ndeleteSession = do\n  let cookie = Cookie (sessionKey @a) (cookiePath @a) Nothing (cookieSecure @a)\n  modifyCookies $ Cookie.insert cookie\n\n\nparseSession :: (Session a, Hyperbole :> es) => Key -> CookieValue -> Eff es a\nparseSession prm cook = do\n  case parseCookie cook of\n    Left e -> send $ RespondNow $ Err $ ErrSession prm e\n    Right a -> pure a\n\n\n-- | save a single datatype to a specific key in the session\nsetCookie :: (ToParam a, Hyperbole :> es) => Cookie -> Eff es ()\nsetCookie ck = do\n  modifyCookies (Cookie.insert ck)\n\n\n-- | Modify the client cookies\nmodifyCookies :: (Hyperbole :> es) => (Cookies -> Cookies) -> Eff es ()\nmodifyCookies f =\n  send $ ModClient $ clientModCookies f\n\n\n-- | Return all the cookies, both those sent in the request and others added by the page\nsessionCookies :: (Hyperbole :> es) => Eff es Cookies\nsessionCookies = do\n  clt <- clientSessionCookies\n  req <- requestSessionCookies\n  pure $ clt <> req\n\n\n-- | Return the session from the Client cookies\nclientSessionCookies :: (Hyperbole :> es) => Eff es Cookies\nclientSessionCookies = do\n  (.session) <$> send GetClient\n\n\n-- | Return the session from the 'Request' cookies\nrequestSessionCookies :: (Hyperbole :> es) => Eff es Cookies\nrequestSessionCookies = do\n  (.cookies) <$> request\n\n\nsessionCookie :: forall a. (Session a) => a -> Cookie\nsessionCookie a =\n  Cookie (sessionKey @a) (cookiePath @a) (Just $ toCookie a) (cookieSecure @a)\n\n\n-- | generic datatype name\ngenericTypeName :: forall a. (Generic a, GDatatypeName (Rep a)) => Text\ngenericTypeName =\n  gDatatypeName $ from (undefined :: a)\n\n\nclass GDatatypeName f where\n  gDatatypeName :: f p -> Text\n\n\ninstance (Datatype d) => GDatatypeName (M1 D d f) where\n  gDatatypeName _ =\n    cs $ datatypeName (undefined :: M1 D d f p)\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Event.hs",
    "content": "module Web.Hyperbole.HyperView.Event where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Text.Casing (kebab)\nimport Web.Atomic.Types\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.HyperView.Handled\nimport Web.Hyperbole.HyperView.Types\nimport Web.Hyperbole.View\n\n\ntype DelayMs = Int\n\n\nevent :: (ViewAction (Action id), Attributable a) => Name -> Action id -> Attributes a -> Attributes a\nevent nm a = att (eventName nm) (encodedToText $ toAction a)\n\n\neventName :: Text -> Name\neventName t = \"data-on\" <> t\n\n\n{- | Send the action after N milliseconds. Can be used to implement lazy loading or polling.\n\n@\n#EMBED Example.Concurrency.LazyLoading viewTaskLoad\n@\n-}\nonLoad :: (ViewAction (Action id), Attributable a) => Action id -> DelayMs -> Attributes a -> Attributes a\nonLoad a delay = do\n  event \"load\" a . att \"data-delay\" (cs $ show delay)\n\n\nonClick :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a\nonClick = event \"click\"\n\n\nonDblClick :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a\nonDblClick = event \"dblclick\"\n\n\nonMouseEnter :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a\nonMouseEnter = event \"mouseenter\"\n\n\nonMouseLeave :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a\nonMouseLeave = event \"mouseleave\"\n\n\n{- | Run an action when the user types into an 'input' or 'textarea'.\n\nWARNING: a short delay can result in poor performance. It is not recommended to set the 'value' of the input\n\n> input (onInput OnSearch) 250 id\n-}\nonInput :: (ViewAction (Action id), Attributable a) => (Text -> Action id) -> DelayMs -> Attributes a -> Attributes a\nonInput a delay = do\n  att (eventName \"input\") (encodedToText $ toActionInput a) . att \"data-delay\" (cs $ show delay)\n\n\n-- WARNING: no way to do this generically right now, because toActionInput is specialized to Text\n--   the change event DOES assume that the target has a string value\n--   but, that doesn't let us implement dropdown\nonChange :: (ViewAction (Action id), Attributable a) => (value -> Action id) -> Attributes a -> Attributes a\nonChange a = do\n  att (eventName \"change\") (encodedToText $ toActionInput a)\n\n\nonSubmit :: (ViewAction (Action id), Attributable a) => Action id -> Attributes a -> Attributes a\nonSubmit = event \"submit\"\n\n\nonKeyDown :: (ViewAction (Action id), Attributable a) => Key -> Action id -> Attributes a -> Attributes a\nonKeyDown key = do\n  event (\"keydown-\" <> keyDataAttribute key)\n\n\nonKeyUp :: (ViewAction (Action id), Attributable a) => Key -> Action id -> Attributes a -> Attributes a\nonKeyUp key = do\n  event (\"keyup-\" <> keyDataAttribute key)\n\n\nkeyDataAttribute :: Key -> Text\nkeyDataAttribute = cs . kebab . showKey\n where\n  showKey (OtherKey t) = cs t\n  showKey k = show k\n\n\n-- https://developer.mozilla.org/en-US/docs/Web/API/UI_Events/Keyboard_event_key_values\ndata Key\n  = ArrowDown\n  | ArrowUp\n  | ArrowLeft\n  | ArrowRight\n  | Enter\n  | Space\n  | Escape\n  | Alt\n  | CapsLock\n  | Control\n  | Fn\n  | Meta\n  | Shift\n  | OtherKey Text\n  deriving (Show, Read)\n\n\n-- | Serialize a constructor that expects a single input, like `data MyAction = GoSearch Text`\ntoActionInput :: (ViewAction a) => (val -> a) -> Encoded\ntoActionInput act =\n  -- laziness should let us drop the last item?\n  -- maybe... I bet it evaluates it strictly\n  let Encoded con vals = toAction (act undefined)\n   in if null vals\n        then Encoded con vals\n        else Encoded con (init vals)\n\n\n-- | Internal\ndataTarget :: (ViewId id, Attributable a) => id -> Attributes a -> Attributes a\ndataTarget = att \"data-target\" . encodedToText . toViewId\n\n\n{- | Allow inputs to trigger actions for a different view\n\n@\n#EMBED Example.Trigger targetView\n@\n-}\ntarget :: forall id ctx. (HyperViewHandled id ctx, ViewId id) => id -> ViewState id -> View id () -> View ctx ()\ntarget newId st view = do\n  runViewContext newId st $ do\n    view @ dataTarget newId\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Forms.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.HyperView.Forms\n  ( FromForm (..)\n  , FromFormF (..)\n  , GenFields (..)\n  , fieldNames\n  , FieldName (..)\n  , FormFields (..)\n  , Field\n  , InputType (..)\n  , Input (..)\n  , field\n  , label\n  , input\n  , checkbox\n  , radioGroup\n  , radio\n  , select\n  , form\n  , textarea\n  , submit\n  , formData\n  , FormOptions (..)\n  , Validated (..)\n  , isInvalid\n  , invalidText\n  , validate\n  , Identity\n\n    -- * Re-exports\n  , FE.FromFormKey\n  , Generic\n  , GFieldsGen (..)\n  , GenField (..)\n  , Form (..)\n  )\nwhere\n\nimport Data.Bifunctor (first)\nimport Data.Functor.Identity (Identity (..))\nimport Data.Kind (Type)\nimport Data.Maybe (fromMaybe)\nimport Data.String (IsString (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, pack)\nimport Effectful\nimport GHC.Generics\nimport Text.Casing (kebab)\nimport Web.Atomic.Types hiding (Selector)\nimport Web.FormUrlEncoded (Form (..), FormOptions (..))\nimport Web.FormUrlEncoded qualified as FE\nimport Web.Hyperbole.Data.Param\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Effect.Request\nimport Web.Hyperbole.Effect.Response (parseError)\nimport Web.Hyperbole.HyperView.Event (onSubmit)\nimport Web.Hyperbole.HyperView.Input (Option (..), checked)\nimport Web.Hyperbole.HyperView.Types\nimport Web.Hyperbole.View\n\n\n------------------------------------------------------------------------------\n-- FORM PARSING\n------------------------------------------------------------------------------\n\n{- | Simple types that be decoded from form data\n\n@\n#EMBED Example.FormSimple data ContactForm\n@\n-}\nclass FromForm (form :: Type) where\n  fromForm :: FE.Form -> Either String form\n  default fromForm :: (Generic form, GFormParse (Rep form)) => FE.Form -> Either String form\n  fromForm f = to <$> gFormParse f\n\n\n{- | A Higher-Kinded type that can be parsed from a 'Web.FormUrlEncoded.Form'\n\n@\n#EMBED Example.FormValidation data UserForm\n@\n-}\nclass FromFormF (f :: (Type -> Type) -> Type) where\n  fromFormF :: FE.Form -> Either String (f Identity)\n  default fromFormF :: (Generic (f Identity), GFormParse (Rep (f Identity))) => FE.Form -> Either String (f Identity)\n  fromFormF f = to <$> gFormParse f\n\n\n-- Any FromFormF can be parsed using fromForm @(form Identity)\n-- we can't make it an instance because it is an orphan instance\ninstance (FromFormF form) => FromForm (form Identity) where\n  fromForm = fromFormF\n\n\n-- | Parse a full type from a submitted form body\nformData :: forall form es. (FromForm form, Hyperbole :> es) => Eff es form\nformData = do\n  f <- formBody\n  let ef = fromForm @form f :: Either String form\n  either parseError pure ef\n\n\n------------------------------------------------------------------------------\n-- GEN FIELDS: Generate a type from selector names\n------------------------------------------------------------------------------\n\n{- | Generate a Higher Kinded record with all selectors filled with default values. See 'GenField'\n\n@\n#EMBED Example.FormValidation data UserForm\n@\n\n@\n#EMBED Example.Contacts newContactForm\n@\n-}\nclass GenFields f (form :: (Type -> Type) -> Type) where\n  genFields :: form f\n  default genFields :: (Generic (form f), GFieldsGen (Rep (form f))) => form f\n  genFields = to gFieldsGen\n\n\n{- | Generate FieldNames for a form\n\n> #EMBED Example.Todos.Todo data TodoForm\n>\n> #EMBED Example.Todos.Todo todoForm\n-}\nfieldNames :: forall form. (GenFields FieldName form) => form FieldName\nfieldNames = genFields\n\n\n-- Given a selector, generate the type\nclass GenField a where\n  genField :: String -> a\n\n\ninstance GenField (FieldName a) where\n  genField s = FieldName $ pack s\n\n\ninstance GenField (Validated a) where\n  genField = const NotInvalid\n\n\ninstance GenField (Maybe a) where\n  genField _ = Nothing\n\n\n------------------------------------------------------------------------------\n-- FORM VIEWS\n------------------------------------------------------------------------------\n\n-- | Context that allows form fields\nnewtype FormFields id = FormFields id\n  deriving (Generic)\n  deriving newtype (ViewId)\n\n\n{- | Type-safe \\<form\\>. Calls (Action id) on submit\n\n@\n#EMBED Example.FormSimple formView\n@\n-}\nform :: (ViewAction (Action id)) => Action id -> View (FormFields id) () -> View id ()\nform a cnt = do\n  tag \"form\" @ onSubmit a $ do\n    runChildView FormFields cnt\n\n\n-- | Button that submits the 'form'\nsubmit :: View (FormFields id) () -> View (FormFields id) ()\nsubmit = tag \"button\" @ att \"type\" \"submit\"\n\n\n-- | Form FieldName. This is embeded as the name attribute, and refers to the key need to parse the form when submitted. See 'fieldNames'\nnewtype FieldName a = FieldName {value :: Text}\n  deriving newtype (Show, IsString, FromParam, ToParam)\n\n\n-- | Display a 'FormField'. See 'form' and 'Form'\nfield\n  :: forall (id :: Type) (a :: Type)\n   . FieldName a\n  -> View (Input id a) ()\n  -> View (FormFields id) ()\nfield fn =\n  runChildView (\\(FormFields i) -> Input i fn)\n\n\n-- | Choose one for 'input's to give the browser autocomplete hints\ndata InputType\n  = -- TODO: there are many more of these: https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes/autocomplete\n    NewPassword\n  | CurrentPassword\n  | Username\n  | Email\n  | Number\n  | TextInput\n  | Name\n  | OneTimeCode\n  | Organization\n  | StreetAddress\n  | Country\n  | CountryName\n  | PostalCode\n  | Search\n  deriving (Show)\n\n\ndata Input (id :: Type) (a :: Type) = Input\n  { id :: id\n  , inputName :: FieldName a\n  }\n  deriving (Generic)\ninstance (ViewId id, FromParam id, ToParam id) => ViewId (Input id a) where\n  type ViewState (Input id a) = ViewState id\n\n\n{- | label for a 'field'\nlabel :: Text -> View (Input id a) ()\n-}\nlabel :: View c () -> View c ()\nlabel = tag \"label\"\n\n\n-- | input for a 'field'\ninput :: forall id a. InputType -> View (Input id a) ()\ninput ft = do\n  inp :: Input id a <- viewId\n  tag \"input\" @ att \"type\" (inpType ft) . name inp.inputName.value . att \"autocomplete\" (auto ft) $ none\n where\n  inpType NewPassword = \"password\"\n  inpType CurrentPassword = \"password\"\n  inpType Number = \"number\"\n  inpType Email = \"email\"\n  inpType Search = \"search\"\n  inpType _ = \"text\"\n\n  auto :: InputType -> Text\n  auto TextInput = \"off\"\n  auto inp = pack . kebab . show $ inp\n\n\ncheckbox :: forall id a. Bool -> View (Input id a) ()\ncheckbox isChecked = do\n  inp :: Input id a <- viewId\n  tag \"input\" @ att \"type\" \"checkbox\" . checked isChecked . name inp.inputName.value $ none\n\n\n-- NOTE: Radio is a special type of selection different from list type or\n-- select. select or list input can be thought of one wrapper and multiple\n-- options whereas radio is multiple wrappers with options. The context required\n-- for radio is more than that required for select.\ndata Radio (id :: Type) (a :: Type) (opt :: Type) = Radio\n  { id :: id\n  , inputName :: FieldName a\n  , defaultOption :: opt\n  }\n  deriving (Generic)\ninstance (FromParam id, ToParam id, FromParam a, ToParam a, ToParam opt, FromParam opt) => ViewId (Radio id a opt) where\n  type ViewState (Radio id a opt) = ViewState id\n\n\nradioGroup :: opt -> View (Radio id a opt) () -> View (Input id a) ()\nradioGroup defOpt = runChildView (\\(inp :: Input id a) -> Radio inp.id inp.inputName defOpt)\n\n\nradio :: forall id a opt. (Eq opt, ToParam opt) => opt -> View (Radio id a opt) ()\nradio val = do\n  rd :: Radio id a opt <- viewId\n  tag \"input\"\n    @ att \"type\" \"radio\"\n    . name rd.inputName.value\n    . value (toParam val).value\n    . checked (rd.defaultOption == val)\n    $ none\n\n\nselect :: forall opt id a. (Eq opt) => opt -> View (Option id opt) () -> View (Input id a) ()\nselect defOpt options = do\n  inp :: Input id a <- viewId\n  tag \"select\" @ name inp.inputName.value $ runChildView (\\_ -> Option inp.id defOpt) options\n\n\n-- | textarea for a 'field'\ntextarea :: forall id a. Maybe Text -> View (Input id a) ()\ntextarea mDefaultText = do\n  inp :: Input id a <- viewId\n  tag \"textarea\" @ name inp.inputName.value $ text $ fromMaybe \"\" mDefaultText\n\n\n------------------------------------------------------------------------------\n-- VALIDATION\n------------------------------------------------------------------------------\n\n{- | Validation results for a 'Form'. See 'validate'\n\n@\n#EMBED Example.FormValidation data UserForm\n\n#EMBED Example.FormValidation validateForm\n\n#EMBED Example.FormValidation validateAge\n@\n-}\ndata Validated a = Invalid Text | NotInvalid | Valid\n  deriving (Show)\n\n\ninstance Semigroup (Validated a) where\n  Invalid t <> _ = Invalid t\n  _ <> Invalid t = Invalid t\n  Valid <> _ = Valid\n  _ <> Valid = Valid\n  a <> _ = a\n\n\ninstance Monoid (Validated a) where\n  mempty = NotInvalid\n\n\n-- instance (FromParam a, ValidateField a) => FromParam (Validated a) where\n--   parseParam inp = do\n--     a <- parseParam @a inp\n--     pure $ validateField a\n\nisInvalid :: Validated a -> Bool\nisInvalid (Invalid _) = True\nisInvalid _ = False\n\n\n-- class ValidateField a where\n--   validateField :: a -> Validated a\n--\n\n-- class ValidationState (v :: Type -> Type) where\n--   convert :: v a -> v b\n--   isInvalid :: v a -> Bool\n--\n--\n-- instance ValidationState Validated where\n--   convert :: Validated a -> Validated b\n--   convert (Invalid t) = Invalid t\n--   convert NotInvalid = NotInvalid\n--   convert Valid = Valid\n--\n--\n\n{- Only shows if 'Validated' is 'Invalid'. See 'formFieldsWith'formform\n@\n@\n-}\ninvalidText :: forall a id. Validated a -> View (Input id a) ()\ninvalidText v = do\n  case v of\n    Invalid t -> text t\n    _ -> none\n\n\n{- | specify a check for a 'Validation'\n\n@\n#EMBED Example.FormValidation validateAge\n@\n-}\nvalidate :: Bool -> Text -> Validated a\nvalidate True t = Invalid t -- Validation [(inputName @a, Invalid t)]\nvalidate False _ = NotInvalid -- Validation [(inputName @a, NotInvalid)]\n\n\n{- | Field allows a Higher Kinded 'Form' to reuse the same selectors for form parsing, generating html forms, and validation\n\n> Field Identity Text ~ Text\n> Field Maybe Text ~ Maybe Text\n-}\ntype family Field (context :: Type -> Type) a\n\n\n-- type instance Field (FormField f) a = FormField f a\ntype instance Field Identity a = a\ntype instance Field FieldName a = FieldName a\ntype instance Field Validated a = Validated a\ntype instance Field Maybe a = Maybe a\ntype instance Field (Either String) a = Either String a\n\n\n------------------------------------------------------------------------------\n-- GENERIC FORM PARSE\n------------------------------------------------------------------------------\n\nclass GFormParse f where\n  gFormParse :: FE.Form -> Either String (f p)\n\n\ninstance (GFormParse f, GFormParse g) => GFormParse (f :*: g) where\n  gFormParse f = do\n    a <- gFormParse f\n    b <- gFormParse f\n    pure $ a :*: b\n\n\ninstance (GFormParse f) => GFormParse (M1 D d f) where\n  gFormParse f = M1 <$> gFormParse f\n\n\ninstance (GFormParse f) => GFormParse (M1 C c f) where\n  gFormParse f = M1 <$> gFormParse f\n\n\n-- TODO: need a bool instance?\n-- TODO: need a Maybe a instance?\ninstance (Selector s, FromParam a) => GFormParse (M1 S s (K1 R a)) where\n  -- these CANNOT be json encoded, they are encoded by the browser\n  gFormParse f = do\n    let sel = selName (undefined :: M1 S s (K1 R (f a)) p)\n    mt :: Maybe Text <- first cs $ FE.lookupMaybe (cs sel) f\n    a <- first (\\err -> sel <> \": \" <> err) $ decodeFormValue mt\n    pure $ M1 . K1 $ a\n\n\n-- instance {-# OVERLAPPING #-} (Selector s, FromParam a) => GFormParse (M1 S s (K1 R (Maybe a))) where\n--   gFormParse f = do\n--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)\n--     mt :: Maybe Text <- first cs $ FE.lookupMaybe (cs sel) f\n--     ma :: Maybe a <- maybe (pure Nothing) (parseParam . decodeParam) mt\n--     pure $ M1 . K1 $ ma\n\n------------------------------------------------------------------------------\n-- GENERIC GENERATE FIELDS\n------------------------------------------------------------------------------\n\nclass GFieldsGen f where\n  gFieldsGen :: f p\n\n\ninstance GFieldsGen U1 where\n  gFieldsGen = U1\n\n\ninstance (GFieldsGen f, GFieldsGen g) => GFieldsGen (f :*: g) where\n  gFieldsGen = gFieldsGen :*: gFieldsGen\n\n\n-- instance (Selector s, GenField g a, Field f a ~ g a) => GFieldsGen (M1 S s (K1 R (g a))) where\n--   gFieldsGen =\n--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)\n--      in M1 . K1 $ genField @g @a sel\n\ninstance (Selector s, GenField a) => GFieldsGen (M1 S s (K1 R a)) where\n  gFieldsGen =\n    let sel = selName (undefined :: M1 S s (K1 R (f a)) p)\n     in M1 . K1 $ genField @a sel\n\n\ninstance (GFieldsGen f) => GFieldsGen (M1 D d f) where\n  gFieldsGen = M1 gFieldsGen\n\n\ninstance (GFieldsGen f) => GFieldsGen (M1 C c f) where\n  gFieldsGen = M1 gFieldsGen\n\n------------------------------------------------------------------------------\n-- GMerge - combine two records with the same structure\n------------------------------------------------------------------------------\n\n-- class GMerge ra rb rc where\n--   gMerge :: ra p -> rb p -> rc p\n--\n--\n-- instance (GMerge ra0 rb0 rc0, GMerge ra1 rb1 rc1) => GMerge (ra0 :*: ra1) (rb0 :*: rb1) (rc0 :*: rc1) where\n--   gMerge (a0 :*: a1) (b0 :*: b1) = gMerge a0 b0 :*: gMerge a1 b1\n--\n--\n-- instance (GMerge ra rb rc) => GMerge (M1 D d ra) (M1 D d rb) (M1 D d rc) where\n--   gMerge (M1 fa) (M1 fb) = M1 $ gMerge fa fb\n--\n--\n-- instance (GMerge ra rb rc) => GMerge (M1 C d ra) (M1 C d rb) (M1 C d rc) where\n--   gMerge (M1 fa) (M1 fb) = M1 $ gMerge fa fb\n--\n--\n-- instance (Selector s, MergeField a b c) => GMerge (M1 S s (K1 R a)) (M1 S s (K1 R b)) (M1 S s (K1 R c)) where\n--   gMerge (M1 (K1 a)) (M1 (K1 b)) = M1 . K1 $ mergeField a b\n--\n--\n-- class MergeField a b c where\n--   mergeField :: a -> b -> c\n\n-- instance MergeField (FieldName a) (Validated a) (FormField Validated a) where\n--   mergeField = FormField\n\n------------------------------------------------------------------------------\n-- GConvert - combine two records with the same structure\n------------------------------------------------------------------------------\n\n-- class ConvertFields a where\n--   convertFields :: (FromSelector f g) => a f -> a g\n--   default convertFields :: (Generic (a f), Generic (a g), GConvert (Rep (a f)) (Rep (a g))) => a f -> a g\n--   convertFields x = to $ gConvert (from x)\n--\n-- class GConvert ra rc where\n--   gConvert :: ra p -> rc p\n--\n--\n-- instance (GConvert ra0 rc0, GConvert ra1 rc1) => GConvert (ra0 :*: ra1) (rc0 :*: rc1) where\n--   gConvert (a0 :*: a1) = gConvert a0 :*: gConvert a1\n--\n--\n-- instance (GConvert ra rc) => GConvert (M1 D d ra) (M1 D d rc) where\n--   gConvert (M1 fa) = M1 $ gConvert fa\n--\n--\n-- instance (GConvert ra rc) => GConvert (M1 C d ra) (M1 C d rc) where\n--   gConvert (M1 fa) = M1 $ gConvert fa\n--\n--\n-- instance (Selector s, GenFieldFrom f g a, Field g a ~ g a) => GConvert (M1 S s (K1 R (f a))) (M1 S s (K1 R (g a))) where\n--   gConvert (M1 (K1 inp)) =\n--     let sel = selName (undefined :: M1 S s (K1 R (f a)) p)\n--      in M1 . K1 $ genFieldFrom @f @g sel inp\n--\n--\n-- class GenFieldFrom inp f a where\n--   genFieldFrom :: String -> inp a -> Field f a\n--\n--\n-- -- instance GenFieldFrom Validated (FormField Validated) a where\n-- --   genFieldFrom s = FormField (FieldName $ pack s)\n--\n-- instance GenFieldFrom val (FormField val) a where\n--   genFieldFrom s = FormField (FieldName $ pack s)\n\n------------------------------------------------------------------------------\n\n-- class GCollect ra v where\n--   gCollect :: ra p -> [v ()]\n--\n--\n-- instance GCollect U1 v where\n--   gCollect _ = []\n--\n--\n-- instance (GCollect f v, GCollect g v) => GCollect (f :*: g) v where\n--   gCollect (a :*: b) = gCollect a <> gCollect b\n--\n--\n-- instance (Selector s, ValidationState v) => GCollect (M1 S s (K1 R (v a))) v where\n--   gCollect (M1 (K1 val)) = [convert val]\n--\n--\n-- instance (GCollect f v) => GCollect (M1 D d f) v where\n--   gCollect (M1 f) = gCollect f\n--\n--\n-- instance (GCollect f v) => GCollect (M1 C c f) v where\n--   gCollect (M1 f) = gCollect f\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Handled.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.HyperView.Handled where\n\nimport Data.Kind (Constraint, Type)\nimport GHC.TypeLits hiding (Mod)\nimport Web.Hyperbole.HyperView.Types\nimport Web.Hyperbole.TypeList\nimport Web.Hyperbole.View (View)\n\n\ntype family ValidDescendents x :: [Type] where\n  ValidDescendents x = x : NextDescendents '[] '[x]\n\n\ntype family NextDescendents (ex :: [Type]) (xs :: [Type]) where\n  NextDescendents _ '[] = '[]\n  NextDescendents ex (x ': xs) =\n    RemoveAll (x : ex) (Require x)\n      <++> NextDescendents ((x : ex) <++> Require x) (RemoveAll (x : ex) (Require x))\n      <++> NextDescendents (x : ex) (RemoveAll (x : ex) xs)\n\n\ntype NotHandled id ctx (views :: [Type]) =\n  TypeError\n    ( 'Text \"HyperView \"\n        :<>: 'ShowType id\n        :<>: 'Text \" not found in (Require \"\n        :<>: 'ShowType ctx\n        :<>: 'Text \")\"\n        :$$: 'Text \"  \"\n          :<>: 'ShowType views\n        :$$: 'Text \"Try adding it to the HyperView instance:\"\n        :$$: 'Text \"  instance HyperView \"\n          :<>: 'ShowType ctx\n          :<>: 'Text \" where\"\n        :$$: 'Text \"    type Action \"\n          :<>: 'ShowType ctx\n          :<>: 'Text \" = \"\n          :<>: ShowType (Action id)\n          :<>: 'Text \"\"\n        :$$: 'Text \"    type Require \"\n          :<>: 'ShowType ctx\n          :<>: 'Text \" = [\"\n          :<>: ShowType id\n          :<>: 'Text \", ...]\"\n    )\n\n\ntype NotDesc id ctx x cs =\n  TypeError\n    ( 'Text \"\"\n        :<>: 'ShowType x\n        :<>: 'Text \", a child of HyperView \"\n        :<>: 'ShowType id\n        :<>: 'Text \", not handled by context \"\n        :<>: 'ShowType ctx\n        :$$: ('Text \" Require = \" ':<>: 'ShowType cs)\n        -- ':$$: 'ShowType x\n        -- ':$$: 'ShowType cs\n    )\n\n\ntype NotInPage x total =\n  TypeError\n    ( 'Text \"\"\n        :<>: 'ShowType x\n        :<>: 'Text \" not included in: \"\n        :$$: 'Text \"  Page es \"\n          :<>: ShowType total\n        :$$: 'Text \"try expanding the page views to:\"\n        :$$: 'Text \"  Page es \"\n          :<>: ShowType (x : total)\n          -- :$$: 'Text \" \" :<>: 'ShowType ctx :<>: 'Text \" = \" :<>: ShowType (Action id) :<>: 'Text \"\"\n          -- :$$: 'Text \"    page :: (Hyperbole :> es) => Page es '[\" :<>: 'ShowType ctx :<>: 'Text \" = [\" :<>: ShowType id :<>: 'Text \", ...]\"\n    )\n\n\ntype family HyperViewHandled id ctx :: Constraint where\n  -- If you forget to pass the state into a function that expects it, you end up passing a view\n  -- in as the ctx. Show an error to help with this\n  HyperViewHandled id (View view ()) = TypeError ('Text \"View c () is not a valid ViewState, did you forget to pass ViewState into target or runViewContext?\")\n  HyperViewHandled id ctx =\n    ( -- the id must be found in the children of the context\n      ElemOr id (ctx : Require ctx) (NotHandled id ctx (Require ctx))\n    , -- Make sure the descendents of id are in the context for the root page\n      CheckDescendents id ctx\n    )\n\n\n-- TODO: Report which view requires the missing one\ntype family CheckDescendents id ctx :: Constraint where\n  CheckDescendents id (Root total) =\n    ( AllInPage (ValidDescendents id) total\n    )\n  CheckDescendents id ctx = ()\n\n\ntype family AllInPage ids total :: Constraint where\n  AllInPage '[] _ = ()\n  AllInPage (x ': xs) total =\n    (ElemOr x total (NotInPage x total), AllInPage xs total)\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Hyper.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.HyperView.Hyper where\n\nimport Web.Atomic.Types\nimport Web.Hyperbole.Data.Encoded as Encoded\nimport Web.Hyperbole.HyperView.Handled (HyperViewHandled)\nimport Web.Hyperbole.HyperView.Types\nimport Web.Hyperbole.View (View, runViewContext, tag)\nimport Web.Hyperbole.View.ViewId\n\n\n{- | Embed a 'HyperView' into a page or another 'View'\n\n@\n#EMBED Example.Docs.Interactive page\n@\n-}\nhyper\n  :: forall id ctx\n   . (HyperViewHandled id ctx, ViewId id, ViewState id ~ (), ConcurrencyValue (Concurrency id))\n  => id\n  -> View id ()\n  -> View ctx ()\nhyper vid = hyperState vid ()\n\n\nhyperState\n  :: forall id ctx\n   . (HyperViewHandled id ctx, ViewId id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id))\n  => id\n  -> ViewState id\n  -> View id ()\n  -> View ctx ()\nhyperState = hyperUnsafe\n\n\nhyperUnsafe :: forall id ctx. (ViewId id, ViewState id ~ ViewState id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id)) => id -> ViewState id -> View id () -> View ctx ()\nhyperUnsafe vid st vw = do\n  tag \"div\" @ att \"id\" (encodedToText $ toViewId vid) . state . concurrency $\n    runViewContext vid st vw\n where\n  concurrency =\n    case concurrencyMode @(Concurrency id) of\n      Drop -> id\n      Replace -> att \"data-concurrency\" (encode Replace)\n\n  state =\n    if encode st == mempty\n      then id\n      else att \"data-state\" (encode st)\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Input.hs",
    "content": "module Web.Hyperbole.HyperView.Input where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport GHC.Generics (Generic)\nimport Web.Atomic.Types\nimport Web.Hyperbole.Data.Param (FromParam, ParamValue (..), ToParam (..))\nimport Web.Hyperbole.HyperView.Event (DelayMs, onChange, onClick, onInput)\nimport Web.Hyperbole.HyperView.Types (HyperView (..))\nimport Web.Hyperbole.Route (Route (..), routeUri)\nimport Web.Hyperbole.View\n\n\n{- | \\<button\\> HTML tag which sends the action when pressed\n\n@\n#EMBED Example.Simple messageView\n@\n-}\nbutton :: (ViewAction (Action id)) => Action id -> View id () -> View id ()\nbutton action cnt = do\n  tag \"button\" cnt @ onClick action\n\n\n{- | Type-safe dropdown. Sends (opt -> Action id) when selected. The default will be selected.\n\n@\n#EMBED Example.DataLists.Filter familyDropdown\n@\n-}\ndropdown\n  :: forall opt id\n   . (ViewAction (Action id))\n  => (opt -> Action id)\n  -> opt -- default option\n  -> View (Option id opt) ()\n  -> View id ()\ndropdown act defOpt options = do\n  st :: ViewState id <- viewState\n  i :: id <- viewId\n  tag \"select\" @ onChange act $ do\n    runViewContext (Option i defOpt) st options\n\n\n-- | An option for a 'dropdown' or 'select'\noption\n  :: forall opt id\n   . (ViewAction (Action id), Eq opt, ToParam opt)\n  => opt\n  -> Text\n  -> View (Option id opt) ()\noption opt cnt = do\n  os :: Option id opt <- viewId\n  tag \"option\" @ att \"value\" (toParam opt).value @ selected (os.defaultOption == opt) $ text cnt\n\n\n-- | sets selected = true if the 'dropdown' predicate returns True\nselected :: (Attributable h) => Bool -> Attributes h -> Attributes h\nselected b = if b then att \"selected\" \"true\" else id\n\n\n-- | The view context for an 'option'\ndata Option id opt = Option\n  { id :: id\n  , defaultOption :: opt\n  }\n  deriving (Generic)\n\n\ninstance (ToParam id, ToParam opt, FromParam id, FromParam opt) => ViewId (Option id opt) where\n  type ViewState (Option id opt) = ViewState id\n\n\n{- | A live search field. Set a DelayMs to avoid hitting the server on every keystroke\n\n@\n#EMBED Example.Errors viewSearchUsers\n@\n-}\nsearch :: (ViewAction (Action id)) => (Text -> Action id) -> DelayMs -> View id ()\nsearch go delay = do\n  tag \"input\" none @ onInput go delay\n\n\n-- | Set checkbox = checked via the client (VDOM doesn't work)\nchecked :: (Attributable a) => Bool -> Attributes a -> Attributes a\nchecked c =\n  att \"data-checked\" (cs $ show c)\n    . if c then att \"checked\" \"\" else id\n\n\n{- | A hyperlink to another route\n\n>>> route (User 100) id \"View User\"\n<a href=\"/user/100\">View User</a>\n-}\nroute :: (Route a) => a -> View c () -> View c ()\nroute r = link (routeUri r)\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView/Types.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE DataKinds #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.HyperView.Types where\n\nimport Data.Kind (Type)\nimport Effectful\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Dynamic\nimport GHC.Generics\nimport Web.Hyperbole.Data.Encoded as Encoded\nimport Web.Hyperbole.Effect.Hyperbole (Hyperbole)\nimport Web.Hyperbole.View (View (..), ViewAction, ViewId (..), none)\n\n\n-- HyperView --------------------------------------------\n\n{- | HyperViews are interactive subsections of a 'Page'\n\nCreate an instance with a unique view id type and a sum type describing the actions the HyperView supports. The View Id can contain context (a database id, for example)\n\n@\n#EMBED Example.Simple data Message\n\n#EMBED Example.Simple instance HyperView Message es where\n@\n-}\nclass (ViewId id, ViewAction (Action id), ConcurrencyValue (Concurrency id)) => HyperView id es where\n  -- | Outline all actions that are permitted in this HyperView\n  --\n  -- > data Action Message = SetMessage Text | ClearMessage\n  -- >   deriving (Generic, ViewAction)\n  data Action id\n\n\n  -- | Include any child hyperviews here. The compiler will make sure that the page knows how to handle them\n  --\n  -- > type Require Messages = '[ChildView]\n  type Require id :: [Type]\n\n\n  type Require id = '[]\n\n\n  -- type ViewState id :: Type\n  -- type ViewState id = ()\n\n  -- | Control how overlapping actions are handled. 'Drop' by default\n  --\n  -- > type Concurrency Autocomplete = Replace\n  type Concurrency id :: ConcurrencyMode\n\n\n  type Concurrency id = Drop\n\n\n  -- | Specify how the view should be updated for each Action\n  --\n  -- > update (SetMessage msg) = pure $ messageView msg\n  -- > update ClearMessage = pure $ messageView \"\"\n  update :: (Hyperbole :> es) => Action id -> Eff (Reader id : State (ViewState id) : es) (View id ())\n\n\ninstance HyperView () es where\n  data Action () = TupleNone\n    deriving (Generic, ViewAction)\n  update _ = pure none\n\n\n-- convert the type to a value\nclass ConcurrencyValue a where\n  concurrencyMode :: ConcurrencyMode\ninstance ConcurrencyValue 'Drop where\n  concurrencyMode = Drop\ninstance ConcurrencyValue 'Replace where\n  concurrencyMode = Replace\n\n\ndata ConcurrencyMode\n  = -- | Do not send any actions that occur while one is active. Prevents double-submitting writes or expensive operations\n    Drop\n  | -- | Ignore the results of older actions in favor of new ones. Use for read-only views with fast-firing interactions, like autocomplete, sliders, etc\n    Replace\n  deriving (Generic, ToEncoded, FromEncoded)\n\n\n-- | The top-level view returned by a 'Page'. It carries a type-level list of every 'HyperView' used in our 'Page' so the compiler can check our work and wire everything together.\ndata Root (views :: [Type]) = Root\n  deriving (Generic, ViewId)\n\n\ninstance HyperView (Root views) es where\n  data Action (Root views) = RootNone\n    deriving (Generic, ViewAction)\n  type Require (Root views) = views\n  update _ = pure none\n"
  },
  {
    "path": "src/Web/Hyperbole/HyperView.hs",
    "content": "module Web.Hyperbole.HyperView\n  ( module Web.Hyperbole.HyperView.Types\n  , module Web.Hyperbole.HyperView.Input\n  , module Web.Hyperbole.HyperView.Event\n  , module Web.Hyperbole.HyperView.Handled\n  , module Web.Hyperbole.HyperView.Hyper\n  , get\n  , put\n  , gets\n  , modify\n  , state\n  , State\n  ) where\n\nimport Effectful.State.Dynamic\nimport Web.Hyperbole.HyperView.Event\nimport Web.Hyperbole.HyperView.Handled\nimport Web.Hyperbole.HyperView.Hyper\nimport Web.Hyperbole.HyperView.Input\nimport Web.Hyperbole.HyperView.Types\n\n"
  },
  {
    "path": "src/Web/Hyperbole/Page.hs",
    "content": "module Web.Hyperbole.Page where\n\nimport Data.Kind (Type)\nimport Effectful\nimport Effectful.Reader.Dynamic\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.HyperView (Root (..))\nimport Web.Hyperbole.Server.Handler (RunHandlers, runLoad)\nimport Web.Hyperbole.Types.Response (Response)\nimport Web.Hyperbole.View (View)\n\n\n{- | An application is divided into multiple [Pages](#g:pages). Each page module should have a 'Page' function, which returns a root 'View'\n\n@\n#EMBED Example.Docs.MultiView page\n@\n-}\ntype Page es (views :: [Type]) = Eff (Reader (Root views) : es) (View (Root views) ())\n\n\n{- | Run a 'Page' and return a 'Response'\n\n@\n#EMBED Example.Docs.BasicPage main\n\n#EMBED Example.Docs.BasicPage page\n@\n-}\nrunPage\n  :: (Hyperbole :> es, RunHandlers views es)\n  => Page es views\n  -> Eff es Response\nrunPage eff = runLoad $ runReader Root eff\n\n\nsubPage\n  :: (Hyperbole :> es)\n  => Eff (Reader (Root inner) : es) a\n  -> Eff es a\nsubPage pg = do\n  runReader Root pg\n"
  },
  {
    "path": "src/Web/Hyperbole/Route.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n{-# LANGUAGE OverloadedLists #-}\n\nmodule Web.Hyperbole.Route\n  ( Route (..)\n  , routeUri\n  , GenRoute (..)\n  , genMatchRoute\n  , genRoutePath\n  , genRouteRead\n  , matchRouteRead\n  , routePathShow\n  , module Web.Hyperbole.Data.URI\n  ) where\n\nimport Control.Applicative ((<|>))\nimport Control.Monad (guard)\nimport Data.Text (Text, pack, toLower, unpack)\nimport Data.Text qualified as T\nimport GHC.Generics\nimport Text.Read (readMaybe)\nimport Web.Hyperbole.Data.URI\nimport Prelude hiding (dropWhile)\n\n\n{- | Derive this class to use a sum type as a route. Constructors and Selectors map intuitively to url patterns\n\n@\n#EMBED Example.Docs.App data AppRoute\n\n#EMBED Example.Docs.App instance Route\n@\n\n>>> routeUri Main\n/\n\n>>> routeUri (User 9)\n/user/9\n-}\nclass Route a where\n  -- | The route to use if attempting to match an empty path\n  baseRoute :: Maybe a\n  default baseRoute :: (Generic a, GenRoute (Rep a)) => Maybe a\n  baseRoute = Nothing\n\n\n  -- | Try to match a path to a route\n  matchRoute :: Path -> Maybe a\n  default matchRoute :: (Generic a, GenRoute (Rep a)) => Path -> Maybe a\n  -- this will match a trailing slash, but not if it is missing\n  matchRoute p =\n    case (p, baseRoute) of\n      ([], Just b) -> pure b\n      (_, _) -> genMatchRoute p.segments\n\n\n  -- | Map a route to a path\n  routePath :: a -> Path\n  default routePath :: (Generic a, Eq a, GenRoute (Rep a)) => a -> Path\n  routePath p\n    | Just p == baseRoute = []\n    | otherwise = Path (genRoutePath p)\n\n\ngenMatchRoute :: (Generic a, GenRoute (Rep a)) => [Segment] -> Maybe a\ngenMatchRoute segs = to <$> genRoute segs\n\n\ngenRoutePath :: (Generic a, GenRoute (Rep a)) => a -> [Segment]\ngenRoutePath = genPaths . from\n\n\n{- | Convert a 'Route' to a 'URI'\n\n>>> routeUri (User 100)\n/user/100\n-}\nrouteUri :: (Route a) => a -> URI\nrouteUri = pathUri . routePath\n\n\n-- | Automatically derive 'Route'\nclass GenRoute f where\n  genRoute :: [Text] -> Maybe (f p)\n  genPaths :: f p -> [Text]\n\n\n-- datatype metadata\ninstance (GenRoute f) => GenRoute (M1 D c f) where\n  genRoute ps = M1 <$> genRoute ps\n  genPaths (M1 x) = genPaths x\n\n\n-- Constructor names / lines\ninstance (Constructor c, GenRoute f) => GenRoute (M1 C c f) where\n  genRoute (n : ps) = do\n    -- take the first path off the list\n    -- check that it matches the constructor name\n    -- check that the rest matches\n    let name = conName (undefined :: M1 C c f x)\n    guard (n == toLower (pack name))\n    M1 <$> genRoute ps\n  genRoute [] = Nothing\n\n\n  genPaths (M1 x) =\n    let name = conName (undefined :: M1 C c f x)\n     in filter (not . T.null) $ toLower (pack name) : genPaths x\n\n\n-- Unary constructors\ninstance GenRoute U1 where\n  genRoute [] = pure U1\n  genRoute _ = Nothing\n  genPaths _ = []\n\n\n-- Selectors\ninstance (GenRoute f) => GenRoute (M1 S c f) where\n  genRoute ps =\n    M1 <$> genRoute ps\n\n\n  genPaths (M1 x) = genPaths x\n\n\n-- Sum types\ninstance (GenRoute a, GenRoute b) => GenRoute (a :+: b) where\n  genRoute ps = L1 <$> genRoute ps <|> R1 <$> genRoute ps\n\n\n  genPaths (L1 a) = genPaths a\n  genPaths (R1 a) = genPaths a\n\n\n-- Product types\ninstance (GenRoute a, GenRoute b) => GenRoute (a :*: b) where\n  genRoute (p : ps) = do\n    ga <- genRoute [p]\n    gr <- genRoute ps\n    pure $ ga :*: gr\n  genRoute _ = Nothing\n\n\n  genPaths (a :*: b) = genPaths a <> genPaths b\n\n\ninstance (Route sub) => GenRoute (K1 R sub) where\n  genRoute ts = K1 <$> matchRoute (Path ts)\n  genPaths (K1 sub) = (routePath sub).segments\n\n\ngenRouteRead :: (Read x) => [Text] -> Maybe (K1 R x a)\ngenRouteRead [t] = do\n  K1 <$> readMaybe (unpack t)\ngenRouteRead _ = Nothing\n\n\ninstance Route Text where\n  matchRoute [t] = pure t\n  matchRoute _ = Nothing\n  routePath t = [t]\n  baseRoute = Nothing\n\n\ninstance Route String where\n  matchRoute [t] = pure (unpack t)\n  matchRoute _ = Nothing\n  routePath t = [pack t]\n  baseRoute = Nothing\n\n\ninstance Route Integer where\n  matchRoute = matchRouteRead\n  routePath = routePathShow\n  baseRoute = Nothing\n\n\ninstance Route Int where\n  matchRoute = matchRouteRead\n  routePath = routePathShow\n  baseRoute = Nothing\n\n\ninstance (Route a) => Route (Maybe a) where\n  matchRoute [] = pure Nothing\n  matchRoute ps = Just <$> matchRoute ps\n  routePath (Just a) = routePath a\n  routePath Nothing = []\n  baseRoute = Nothing\n\n\nmatchRouteRead :: (Read a) => Path -> Maybe a\nmatchRouteRead [t] = readMaybe (unpack t)\nmatchRouteRead _ = Nothing\n\n\nroutePathShow :: (Show a) => a -> Path\nroutePathShow a = [pack (show a)]\n"
  },
  {
    "path": "src/Web/Hyperbole/Server/Handler.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.Server.Handler where\n\nimport Data.Kind (Type)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Dynamic\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Effect.Response (hyperView, respondError)\nimport Web.Hyperbole.HyperView\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\nimport Web.Hyperbole.View\n\n\nclass RunHandlers (views :: [Type]) es where\n  runHandlers :: (Hyperbole :> es) => Event TargetViewId Encoded Encoded -> Eff es (Maybe Response)\n\n\ninstance RunHandlers '[] es where\n  runHandlers _ = pure Nothing\n\n\ninstance (HyperView view es, ToEncoded (ViewState view), FromEncoded (ViewState view), RunHandlers views es) => RunHandlers (view : views) es where\n  runHandlers rawEvent = do\n    mr <- runHandler @view rawEvent (update @view)\n    case mr of\n      Nothing -> runHandlers @views rawEvent\n      Just r -> pure (Just r)\n\n\nrunHandler\n  :: forall id es\n   . (HyperView id es, ToEncoded (ViewState id), FromEncoded (ViewState id), Hyperbole :> es)\n  => Event TargetViewId Encoded Encoded\n  -> (Action id -> Eff (Reader id : State (ViewState id) : es) (View id ()))\n  -> Eff es (Maybe Response)\nrunHandler rawEvent run = do\n  -- Get an event matching our type. If it doesn't match, skip to the next handler\n  mev <- decodeEvent @id rawEvent :: Eff es (Maybe (Event id (Action id) (ViewState id)))\n  case mev of\n    Just evt -> do\n      (vw, st) <- runStateLocal evt.state $ runReader evt.viewId $ run evt.action\n      res <- hyperView evt.viewId st vw\n      pure $ Just res\n    _ -> do\n      pure Nothing\n\n\nrunLoad\n  :: forall views es\n   . (Hyperbole :> es, RunHandlers views es)\n  => Eff es (View (Root views) ())\n  -> Eff es Response\nrunLoad page = do\n  ev <- (.event) <$> send GetRequest\n  case ev of\n    Just rawEvent -> do\n      res <- runHandlers @views rawEvent\n      case res of\n        -- if we found an event, it should have been handled by one of the views\n        Nothing -> respondError $ ErrNotHandled rawEvent\n        Just r -> pure r\n    Nothing -> do\n      loadPageResponse page\n\n\nloadPageResponse :: Eff es (View (Root total) ()) -> Eff es Response\nloadPageResponse run = do\n  vw <- run\n  let vid = TargetViewId $ toViewId Root\n  let res = Response $ ViewUpdate vid $ renderBody $ runViewContext Root () vw\n  pure res\n\n\n-- despite not needing any effects, this must be in Eff es to get `es` on the RHS\ndecodeEvent :: forall id es. (HyperView id es, FromEncoded (ViewState id)) => Event TargetViewId Encoded Encoded -> Eff es (Maybe (Event id (Action id) (ViewState id)))\ndecodeEvent (Event (TargetViewId ti) eact est) =\n  pure $ either (const Nothing) Just $ do\n    vid <- parseViewId ti\n    act <- parseAction eact\n    st <- parseEncoded est\n    pure $ Event vid act st\n"
  },
  {
    "path": "src/Web/Hyperbole/Server/Message.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Server.Message where\n\nimport Control.Applicative ((<|>))\nimport Control.Exception (Exception)\nimport Data.Aeson qualified as Aeson\nimport Data.Attoparsec.Text (Parser, char, endOfLine, isEndOfLine, parseOnly, sepBy, string, takeText, takeTill, takeWhile1)\nimport Data.ByteString qualified as BS\nimport Data.ByteString.Lazy qualified as BL\nimport Data.List qualified as L\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport GHC.Generics (Generic)\nimport Web.Hyperbole.Data.Cookie (Cookie, Cookies)\nimport Web.Hyperbole.Data.Cookie qualified as Cookie\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.QueryData (QueryData)\nimport Web.Hyperbole.Data.QueryData qualified as QueryData\nimport Web.Hyperbole.Data.URI (Path)\nimport Web.Hyperbole.Effect.Hyperbole (Remote (..))\nimport Web.Hyperbole.Types.Client (Client (..))\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.View (ViewId)\n\n\n{-\n |UPDATE|\n viewId: wahoo\n action: hello\n requestId: ipgeim\n\n body\n body\n body\n-}\n\ndata Message = Message\n  { messageType :: Text\n  , event :: Event TargetViewId Encoded Encoded\n  , requestId :: RequestId\n  , metadata :: Metadata\n  , body :: MessageBody\n  }\n  deriving (Show)\n\n\nnewtype MessageBody = MessageBody {value :: BL.ByteString}\n  deriving newtype (Show)\n\n\ndata MessageError\n  = InvalidMessage String Text\n  | InvalidCookie BS.ByteString String\n  | MissingMeta String\n  deriving (Show, Exception)\n\n\n-- Read Messages -------------------------------------\n\nmimeType :: Text\nmimeType = \"application/hyperbole.message\"\n\n\nparseActionMessage :: Text -> Either String Message\nparseActionMessage = parseOnly parser\n where\n  parser :: Parser Message\n  parser = do\n    mt <- messageType\n    ev <- event\n    rq <- requestId\n    ms <- meta `sepBy` endOfLine\n    bd <- body\n    pure $ Message mt ev rq (mconcat ms) bd\n\n  messageType :: Parser Text\n  messageType = do\n    _ <- char '|'\n    t <- takeWhile1 (/= '|')\n    _ <- char '|'\n    endOfLine\n    pure t\n\n  body :: Parser MessageBody\n  body = do\n    MessageBody . cs . T.strip <$> takeText\n\n  event :: Parser (Event TargetViewId Encoded Encoded)\n  event = do\n    vid <- targetViewId\n    act <- encodedAction\n    st <- encodedState <|> pure mempty\n    pure $ Event vid act st\n   where\n    targetViewId :: Parser TargetViewId\n    targetViewId = do\n      _ <- string \"ViewId: \"\n      line <- takeLine\n      v <- case encodedParseText line of\n        Left e -> fail $ \"Parse Encoded ViewId failed: \" <> cs e <> \" from \" <> cs line\n        Right a -> pure $ TargetViewId a\n      endOfLine\n      pure v\n\n    encodedAction :: Parser Encoded\n    encodedAction = do\n      _ <- string \"Action: \"\n      inp <- takeLine\n      v <- case encodedParseText inp of\n        Left e -> fail $ \"Parse Encoded ViewAction failed: \" <> cs e <> \" from \" <> cs inp\n        Right a -> pure a\n      endOfLine\n      pure v\n\n    encodedState :: Parser Encoded\n    encodedState = do\n      _ <- string \"State: \"\n      inp <- takeLine\n      v <- case encodedParseText inp of\n        Left e -> fail $ \"Parse Encoded ViewState failed: \" <> cs e <> \" from \" <> cs inp\n        Right a -> pure a\n      endOfLine\n      pure v\n\n  requestId :: Parser RequestId\n  requestId = do\n    _ <- string \"RequestId: \"\n    r <- RequestId <$> takeLine\n    endOfLine\n    pure r\n\n  meta :: Parser Metadata\n  meta = do\n    key <- metaKey\n    value <- takeLine\n    pure $ metadata (cs key) value\n\n  metaKey :: Parser MetaKey\n  metaKey = do\n    key <- takeWhile1 (/= ':')\n    _ <- string \": \"\n    pure key\n\n  takeLine :: Parser Text\n  takeLine = do\n    takeTill isEndOfLine\n\n\n-- Render ---------------------------------------------\n\nrenderMetadata :: Metadata -> Text\nrenderMetadata (Metadata m) = T.intercalate \"\\n\" $ fmap (uncurry metaLine) m\n\n\nmetaLine :: MetaKey -> Text -> Text\nmetaLine name value = name <> \": \" <> cs value\n\n\n-- Metadata --------------------------------------------\n\ntype MetaKey = Text\n\n\nnewtype Metadata = Metadata [(Text, Text)]\n  deriving newtype (Semigroup, Monoid)\n  deriving (Show, Generic)\n  deriving anyclass (ViewId)\n\n\n-- instance HyperView Metadata es where\n--   data Action Metadata = MetaNone\n--     deriving (Generic, ViewAction)\n--   update _ = pure none\n\nmetadata :: MetaKey -> Text -> Metadata\nmetadata key value = Metadata [(key, value)]\n\n\nlookupMetadata :: MetaKey -> Metadata -> Maybe Text\nlookupMetadata key (Metadata kvs) = L.lookup key kvs\n\n\nrequestMetadata :: Request -> Metadata\nrequestMetadata req =\n  maybe mempty eventMetadata req.event <> metaRequestId req.requestId\n where\n  metaRequestId :: RequestId -> Metadata\n  metaRequestId (RequestId \"\") = mempty\n  metaRequestId (RequestId reqId) =\n    metadata \"RequestId\" (cs reqId)\n\n  eventMetadata :: Event TargetViewId Encoded Encoded -> Metadata\n  eventMetadata event =\n    Metadata\n      [ (\"ViewId\", encodedToText event.viewId.encoded)\n      , (\"Action\", encodedToText event.action)\n      ]\n\n\ntargetViewMetadata :: TargetViewId -> Metadata\ntargetViewMetadata (TargetViewId vid) = Metadata [(\"TargetViewId\", encodedToText vid)]\n\n\nresponseMetadata :: Path -> Client -> [Remote] -> Metadata\nresponseMetadata reqPath client remotes =\n  clientMetadata reqPath client <> metaRemotes remotes\n\n\nclientMetadata :: Path -> Client -> Metadata\nclientMetadata reqPath client =\n  metaSession client.session <> metaQuery client.query <> metaPageTitle client.pageTitle\n where\n  metaPageTitle :: Maybe Text -> Metadata\n  metaPageTitle = \\case\n    Nothing -> mempty\n    Just pt -> metadata \"PageTitle\" pt\n\n  metaQuery :: Maybe QueryData -> Metadata\n  metaQuery Nothing = mempty\n  metaQuery (Just q) =\n    Metadata [(\"Query\", cs $ QueryData.render q)]\n\n  metaSession :: Cookies -> Metadata\n  metaSession cookies = mconcat $ fmap metaCookie $ Cookie.toList cookies\n   where\n    metaCookie :: Cookie -> Metadata\n    metaCookie cookie =\n      Metadata [(\"Cookie\", cs (Cookie.render reqPath cookie))]\n\n\nmetaRemotes :: [Remote] -> Metadata\nmetaRemotes = mconcat . fmap metaRemote\n\n\nmetaRemote :: Remote -> Metadata\nmetaRemote = \\case\n  RemoteAction (TargetViewId vid) act ->\n    metadata \"Trigger\" $ encodedToText vid <> \"|\" <> encodedToText act\n  RemoteEvent ev dat ->\n    metadata \"Event\" $ T.intercalate \"|\" [ev, cs $ Aeson.encode dat]\n\n\nmetaError :: Text -> Metadata\nmetaError = metadata \"Error\"\n\n\n-- metaRedirect :: URI -> Metadata\n-- metaRedirect u = metadata \"Redirect\" (uriToText u)\n\ndata ContentType\n  = ContentHtml\n  | ContentText\n\n\ndata RenderedMessage\n  = MessageHtml BL.ByteString\n  | MessageText Text\n  | MessageNone\n"
  },
  {
    "path": "src/Web/Hyperbole/Server/Options.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Server.Options where\n\nimport Data.ByteString.Lazy qualified as BL\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport Web.Atomic.CSS\nimport Web.Hyperbole.Data.Encoded (Encoded, encodedToText)\nimport Web.Hyperbole.Types.Event\nimport Web.Hyperbole.Types.Response\nimport Web.Hyperbole.View\n\n\ndata ServerOptions = ServerOptions\n  { toDocument :: BL.ByteString -> BL.ByteString\n  , serverError :: ResponseError -> ServerError\n  }\n\n\ndefaultErrorMessage :: ResponseError -> Text\ndefaultErrorMessage = \\case\n  -- mask server errors\n  ErrCustom e -> e.message\n  NotFound -> \"Not Found\"\n  ErrInternal -> \"Internal Server Error\"\n  ErrServer m -> m\n  e -> cs $ drop 3 $ show e\n\n\ndefaultErrorBody :: Text -> Body\ndefaultErrorBody msg = Body $\n  renderLazyByteString $ do\n    el ~ bg (HexColor \"#F00\") . color (HexColor \"#FFF\") $ do\n      text msg\n\n\ndefaultError :: ResponseError -> ServerError\ndefaultError = \\case\n  ErrCustom e -> e\n  ErrNotHandled e -> errNotHandled e\n  err ->\n    let msg = defaultErrorMessage err\n     in ServerError msg (defaultErrorBody msg)\n where\n  errNotHandled :: Event TargetViewId Encoded Encoded -> ServerError\n  errNotHandled ev =\n    ServerError \"Action Not Handled\" $ Body $ renderLazyByteString $ do\n      el $ do\n        text \"No Handler for Event viewId: \"\n        text $ encodedToText ev.viewId.encoded\n        text \" action: \"\n        text $ encodedToText ev.action\n      el $ do\n        text \"Remember to add a `hyper` handler in your page function\"\n      pre $\n        T.intercalate\n          \"\\n\"\n          [ \"page :: (Hyperbole :> es) => Page es Response\"\n          , \"page = do\"\n          , \"  handle contentsHandler\"\n          , \"  load $ do\"\n          , \"    pure $ hyper Contents contentsView\"\n          , \"</pre>\"\n          ]\n"
  },
  {
    "path": "src/Web/Hyperbole/Server/Socket.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Server.Socket where\n\nimport Control.Monad (void)\nimport Data.Aeson (Value)\nimport Data.Bifunctor (first)\nimport Data.List qualified as L\nimport Data.Map (Map)\nimport Data.Map qualified as M\nimport Data.Maybe (fromMaybe)\nimport Data.String (IsString)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Effectful\nimport Effectful.Concurrent.Async\nimport Effectful.Concurrent.STM (TVar, atomically, modifyTVar, readTVar, writeTVar)\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Error.Static (throwError_)\nimport Effectful.Exception\nimport Effectful.State.Static.Local as Local (get, modify)\nimport Network.HTTP.Types as HTTP (parseQuery)\nimport Network.Wai qualified as Wai\nimport Network.WebSockets (Connection)\nimport Network.WebSockets qualified as WS\nimport Web.Cookie qualified\nimport Web.Hyperbole.Data.Cookie qualified as Cookie\nimport Web.Hyperbole.Data.Encoded (Encoded, encodedToText)\nimport Web.Hyperbole.Data.URI (URI, path, uriToText)\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Server.Message\nimport Web.Hyperbole.Server.Options\nimport Web.Hyperbole.Types.Client\nimport Web.Hyperbole.Types.Event (Event (..), TargetViewId (..))\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\n\n\ndata SocketRequest = SocketRequest\n  { request :: Maybe Request\n  }\n\n\ntype RunningActions = Map TargetViewId (Encoded, Async ())\n\n\nrunHyperboleSocket\n  :: (IOE :> es)\n  => ServerOptions\n  -> Connection\n  -> Request\n  -> Eff (Hyperbole : es) Response\n  -> Eff es (Response, Client, [Remote])\nrunHyperboleSocket _opts conn req = reinterpret (runHyperboleLocal req) $ \\_ -> \\case\n  GetRequest -> do\n    pure req\n  RespondNow r -> do\n    throwError_ r\n  GetClient -> do\n    Local.get @Client\n  ModClient f -> do\n    Local.modify @Client f\n  PushUpdate (ViewUpdate vid vw) -> do\n    sendUpdate conn req vid vw\n  PushTrigger vid act -> do\n    sendTrigger conn req vid act\n  PushEvent name dat -> do\n    sendEvent conn req name dat\n\n\nhandleRequestSocket\n  :: (IOE :> es, Concurrent :> es)\n  => ServerOptions\n  -> TVar RunningActions\n  -> Wai.Request\n  -> Connection\n  -> Eff (Hyperbole : es) Response\n  -> Eff es ()\nhandleRequestSocket opts actions wreq conn eff = do\n  flip catch onMessageError $ do\n    msg <- receiveMessage\n    req <- parseMessageRequest msg\n\n    a <- async $ do\n      -- is one already running?\n      res <- trySync $ runHyperboleSocket opts conn req eff\n      case res of\n        -- TODO: catch socket errors separately from SomeException?\n        Left (ex :: SomeException) -> do\n          -- It's not safe to send any exception over the wire\n          -- log it to the console and send the error to the client\n          liftIO $ print ex\n          res2 <- trySync $ sendError conn (requestMetadata req) (opts.serverError ErrInternal)\n          case res2 of\n            Left e -> liftIO $ putStrLn $ \"Socket Error while sending previous error to client: \" <> show e\n            Right _ -> pure ()\n        Right (resp, clnt, rmts) -> do\n          let meta = requestMetadata req <> responseMetadata req.path clnt rmts\n          case resp of\n            (Response (ViewUpdate _ vw)) -> do\n              sendResponse conn meta vw\n            (Err err) -> sendError conn meta (opts.serverError err)\n            (Redirect url) -> sendRedirect conn meta url\n\n    addRunningAction a req.requestId req.event\n\n    void $ async $ do\n      _ <- waitCatch a\n      clearRunningAction req.requestId req.event\n where\n  addRunningAction :: (IOE :> es, Concurrent :> es) => Async () -> RequestId -> Maybe (Event TargetViewId Encoded Encoded) -> Eff es ()\n  addRunningAction a (RequestId reqId) = \\case\n    Nothing -> pure ()\n    Just (Event vid act _) -> do\n      -- liftIO $ putStrLn $ \" [add] (\" <> cs reqId <> \") \" <> cs clientId.value <> \"|\" <> show vid\n      maold <- atomically $ do\n        m <- readTVar @RunningActions actions\n        writeTVar actions $ M.insert vid (act, a) m\n        pure $ M.lookup vid m\n      case maold of\n        Nothing -> pure ()\n        Just (actold, aold) -> do\n          liftIO $ putStrLn $ \"CANCEL (\" <> cs reqId <> \") \" <> cs (encodedToText vid.encoded) <> \": \" <> cs (encodedToText actold)\n          cancel aold\n\n  clearRunningAction :: (IOE :> es, Concurrent :> es) => RequestId -> Maybe (Event TargetViewId Encoded Encoded) -> Eff es ()\n  clearRunningAction (RequestId _) = \\case\n    Nothing -> pure ()\n    Just (Event vid _ _) -> do\n      _ <- atomically $ modifyTVar actions $ M.delete vid\n      pure ()\n\n  onMessageError :: (IOE :> es) => MessageError -> Eff es a\n  onMessageError e = do\n    liftIO $ do\n      putStrLn \"Socket Message Error\"\n    throwIO e\n\n  receiveMessage :: (IOE :> es) => Eff es Message\n  receiveMessage = do\n    t <- receiveText conn\n    case parseActionMessage t of\n      Left e -> throwIO $ InvalidMessage e t\n      Right msg -> pure msg\n\n  receiveText :: (IOE :> es) => Connection -> Eff es Text\n  receiveText _ = do\n    -- c <- ask @Connection\n    liftIO $ WS.receiveData conn\n\n  parseMessageRequest :: (IOE :> es) => Message -> Eff es Request\n  parseMessageRequest msg =\n    case messageRequest msg of\n      Left e -> throwIO e\n      Right a -> pure a\n\n  messageRequest :: Message -> Either MessageError Request\n  messageRequest msg = do\n    let pth = path $ cs $ Wai.rawPathInfo wreq\n        host = Host $ fromMaybe \"\" $ L.lookup \"Host\" headers\n        headers = Wai.requestHeaders wreq\n        method = \"POST\"\n\n        body = msg.body.value\n\n    query <- HTTP.parseQuery . cs <$> requireMeta \"Query\" msg.metadata\n    cookie <- cs <$> requireMeta \"Cookie\" msg.metadata\n\n    cookies <- first (InvalidCookie cookie) <$> Cookie.parse $ Web.Cookie.parseCookies cookie\n\n    pure $\n      Request\n        { path = pth\n        , event = Just msg.event\n        , host\n        , query\n        , body\n        , method\n        , cookies\n        , requestId = msg.requestId\n        }\n   where\n    requireMeta :: MetaKey -> Metadata -> Either MessageError Text\n    requireMeta key m =\n      maybe (Left $ MissingMeta (cs key)) pure $ lookupMetadata key m\n\n\nsendResponse :: (IOE :> es) => Connection -> Metadata -> Body -> Eff es ()\nsendResponse conn meta (Body b) = do\n  sendMessage \"RESPONSE\" conn meta (MessageHtml b)\n\n\nsendUpdate :: (IOE :> es) => Connection -> Request -> TargetViewId -> Body -> Eff es ()\nsendUpdate conn req vid (Body b) = do\n  sendMessage \"UPDATE\" conn (requestMetadata req <> targetViewMetadata vid) (MessageHtml b)\n\n\nsendTrigger :: (IOE :> es) => Connection -> Request -> TargetViewId -> Encoded -> Eff es ()\nsendTrigger conn req vid act = do\n  sendRemote \"TRIGGER\" conn req $ RemoteAction vid act\n\n\nsendEvent :: (IOE :> es) => Connection -> Request -> Text -> Value -> Eff es ()\nsendEvent conn req nm val = do\n  sendRemote \"EVENT\" conn req $ RemoteEvent nm val\n\n\nsendRedirect :: (IOE :> es) => Connection -> Metadata -> URI -> Eff es ()\nsendRedirect conn meta u = do\n  sendMessage \"REDIRECT\" conn meta (MessageText $ uriToText u)\n\n\nsendError :: (IOE :> es) => Connection -> Metadata -> ServerError -> Eff es ()\nsendError conn meta (ServerError err (Body body)) = do\n  sendMessage \"UPDATE\" conn (metadata \"Error\" err <> meta) (MessageHtml body)\n\n\nnewtype Command = Command Text\n  deriving newtype (IsString)\n\n\nsendRemote :: (IOE :> es) => Command -> Connection -> Request -> Remote -> Eff es ()\nsendRemote cmd conn req remote = do\n  sendMessage cmd conn (requestMetadata req <> metaRemote remote) MessageNone\n\n\n-- low level message. Use sendResponse\nsendMessage :: (MonadIO m) => Command -> Connection -> Metadata -> RenderedMessage -> m ()\nsendMessage (Command cmd) conn meta' msg = do\n  let header = \"|\" <> cs cmd <> \"|\\n\" <> cs (renderMetadata meta')\n\n  let body = case msg of\n        MessageHtml html -> \"\\n\\n\" <> html\n        MessageText t -> \"\\n\\n\" <> cs t\n        MessageNone -> \"\"\n\n  liftIO $ WS.sendTextData conn (header <> body)\n"
  },
  {
    "path": "src/Web/Hyperbole/Server/Wai.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Web.Hyperbole.Server.Wai where\n\nimport Data.Bifunctor (first)\nimport Data.ByteString qualified as BS\nimport Data.ByteString.Lazy qualified as BL\nimport Data.List qualified as L\nimport Data.Maybe (fromMaybe)\nimport Data.String.Conversions (cs)\nimport Data.String.Interpolate (i)\nimport Effectful\nimport Effectful.Dispatch.Dynamic\nimport Effectful.Error.Static (throwError_)\nimport Effectful.Exception (throwIO)\nimport Effectful.State.Static.Local (get, modify)\nimport Effectful.Writer.Static.Local (tell)\nimport Network.HTTP.Types (Header, HeaderName, status200, status400, status401, status404, status500)\nimport Network.Wai qualified as Wai\nimport Network.Wai.Internal (ResponseReceived (..))\nimport Web.Atomic (att, (@))\nimport Web.Cookie qualified\nimport Web.Hyperbole.Data.Cookie (Cookie, Cookies)\nimport Web.Hyperbole.Data.Cookie qualified as Cookie\nimport Web.Hyperbole.Data.Encoded (Encoded, decode)\nimport Web.Hyperbole.Data.URI (path, uriToText)\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Server.Message\nimport Web.Hyperbole.Server.Options\nimport Web.Hyperbole.Types.Client\nimport Web.Hyperbole.Types.Event (Event (..), TargetViewId (..))\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\nimport Web.Hyperbole.View (View, renderLazyByteString, runViewContext, script', type_)\n\n\nhandleRequestWai\n  :: (IOE :> es)\n  => ServerOptions\n  -> Wai.Request\n  -> (Wai.Response -> IO ResponseReceived)\n  -> Eff (Hyperbole : es) Response\n  -> Eff es Wai.ResponseReceived\nhandleRequestWai options req respond actions = do\n  -- NOTE: Remember, this is called for both updates AND for page loads\n  body <- liftIO $ Wai.consumeRequestBodyLazy req\n  rq <- either throwIO pure $ do\n    fromWaiRequest req body\n  (res, client, rmts) <- runHyperboleWai rq actions\n  liftIO $ sendResponse options rq client res rmts respond\n\n\n-- | Run the 'Hyperbole' effect to get a response\nrunHyperboleWai\n  :: Request\n  -> Eff (Hyperbole : es) Response\n  -> Eff es (Response, Client, [Remote])\nrunHyperboleWai req = reinterpret (runHyperboleLocal req) $ \\_ -> \\case\n  GetRequest -> do\n    pure req\n  RespondNow r -> do\n    throwError_ r\n  GetClient -> do\n    get @Client\n  ModClient f -> do\n    modify @Client f\n  PushUpdate _ -> do\n    -- ignore! you can't push updates using WAI\n    -- whatever you end up returning after all pushes will be what the user sees\n    pure ()\n  PushTrigger vid act -> do\n    -- deferred until the response\n    tell [RemoteAction vid act]\n  PushEvent name dat -> do\n    -- deferred until the response\n    tell [RemoteEvent name dat]\n\n\nsendResponse :: ServerOptions -> Request -> Client -> Response -> [Remote] -> (Wai.Response -> IO ResponseReceived) -> IO Wai.ResponseReceived\nsendResponse options req client res remotes respond = do\n  let metas = requestMetadata req <> responseMetadata req.path client remotes\n  respond $ response metas res\n where\n  response :: Metadata -> Response -> Wai.Response\n  response metas = \\case\n    (Err err) ->\n      respondError (errStatus err) [] $ options.serverError err\n    (Response (ViewUpdate _ vw)) -> do\n      respondHtml status200 (clientHeaders client) $ renderViewResponse metas vw\n    (Redirect u) -> do\n      let url = uriToText u\n      let hs = (\"Location\", cs url) : clientHeaders client\n      respondHtml status200 hs $ renderViewResponse metas $ Body $ renderLazyByteString $ do\n        script'\n          [i|window.location = '#{uriToText u}'|]\n\n  errStatus = \\case\n    NotFound -> status404\n    ErrParse _ -> status400\n    ErrQuery _ -> status400\n    ErrSession _ _ -> status400\n    ErrAuth _ -> status401\n    _ -> status500\n\n  -- convert to document if full page request\n  addDocument :: BL.ByteString -> BL.ByteString\n  addDocument body =\n    case req.event of\n      Nothing -> options.toDocument body\n      _ -> body\n\n  renderViewResponse :: Metadata -> Body -> BL.ByteString\n  renderViewResponse metas (Body body) =\n    addDocument $ renderLazyByteString (runViewContext metas () $ scriptMeta metas) <> \"\\n\\n\" <> body\n\n  respondError s hs serr = respondHtml s hs $ renderViewResponse (metaError serr.message) serr.body\n  respondHtml s hs = Wai.responseLBS s (contentType ContentHtml : hs)\n  -- respondText s hs = Wai.responseLBS s (contentType ContentText : hs)\n\n  -- via HTTP, we want to manually set some headers rather than just rely on the client\n  clientHeaders :: Client -> [Header]\n  clientHeaders = setCookies\n   where\n    setCookies clnt =\n      fmap setCookie $ Cookie.toList clnt.session\n\n    setCookie :: Cookie -> (HeaderName, BS.ByteString)\n    setCookie cookie =\n      (\"Set-Cookie\", Cookie.render req.path cookie)\n\n\nscriptMeta :: Metadata -> View Metadata ()\nscriptMeta m =\n  script' @ type_ \"application/hyp.metadata\" . att \"id\" \"hyp.metadata\" $\n    cs $\n      \"\\n\" <> renderMetadata m <> \"\\n\"\n\n\nmessageFromBody :: BL.ByteString -> Either MessageError Message\nmessageFromBody inp = do\n  first (\\e -> InvalidMessage e (cs inp)) $ parseActionMessage (cs inp)\n\n\nfromWaiRequest :: Wai.Request -> BL.ByteString -> Either MessageError Request\nfromWaiRequest wr body = do\n  let pth = path $ cs $ Wai.rawPathInfo wr\n      query = Wai.queryString wr\n      headers = Wai.requestHeaders wr\n      cookie = fromMaybe \"\" $ L.lookup \"Cookie\" headers\n      host = Host $ fromMaybe \"\" $ L.lookup \"Host\" headers\n      requestId = RequestId $ cs $ fromMaybe \"\" $ L.lookup \"Hyp-RequestId\" headers\n      method = Wai.requestMethod wr\n      event = lookupEvent headers\n  cookies <- fromCookieHeader cookie\n\n  pure $\n    Request\n      { body = body\n      , path = pth\n      , event\n      , query\n      , method\n      , cookies\n      , host\n      , requestId\n      }\n where\n  lookupEvent :: [Header] -> Maybe (Event TargetViewId Encoded Encoded)\n  lookupEvent headers = do\n    viewIdText <- cs <$> L.lookup \"Hyp-ViewId\" headers\n    actText <- cs <$> L.lookup \"Hyp-Action\" headers\n    stText <- cs <$> L.lookup \"Hyp-State\" headers\n    act <- decode actText\n    viewId <- TargetViewId <$> decode viewIdText\n    st <- decode stText\n    pure $ Event viewId act st\n\n\n-- Client only returns ONE Cookie header, with everything concatenated\nfromCookieHeader :: BS.ByteString -> Either MessageError Cookies\nfromCookieHeader h =\n  case Cookie.parse (Web.Cookie.parseCookies h) of\n    Left err -> Left $ InvalidCookie h err\n    Right a -> pure a\n\n\ncontentType :: ContentType -> (HeaderName, BS.ByteString)\ncontentType ContentHtml = (\"Content-Type\", \"text/html; charset=utf-8\")\ncontentType ContentText = (\"Content-Type\", \"text/plain; charset=utf-8\")\n"
  },
  {
    "path": "src/Web/Hyperbole/TypeList.hs",
    "content": "{-# LANGUAGE UndecidableInstances #-}\n\nmodule Web.Hyperbole.TypeList where\n\nimport Data.Kind (Constraint, Type)\nimport GHC.TypeLits hiding (Mod)\n\n\n-- concat lists\ntype family (<++>) xs ys where\n  '[] <++> ys = ys\n  xs <++> '[] = xs\n  (x ': xs) <++> ys = x : xs <++> ys\n\n\ntype family Remove x ys where\n  Remove x '[] = '[]\n  Remove x (x ': ys) = Remove x ys\n  Remove x (y ': ys) = y ': Remove x ys\n\n\ntype family RemoveAll xs ys where\n  RemoveAll '[] ys = ys\n  RemoveAll xs '[] = '[]\n  RemoveAll (x ': xs) ys = RemoveAll xs (Remove x ys)\n\n\n-- Type family to check if an element is in a type-level list\ntype Elem e es = ElemOr e es (NotElem e es)\n\n\n-- 'orig' is used to store original list for better error messages\ntype family ElemOr e es err :: Constraint where\n  ElemOr x (x ': xs) err = ()\n  ElemOr y (x ': xs) err = ElemOr y xs err\n  -- Note [Custom Errors]\n  ElemOr x '[] err = err\n\n\ntype family AllElemOr xs ys err :: Constraint where\n  AllElemOr '[] _ _ = ()\n  AllElemOr (x ': xs) ys err =\n    (ElemOr x ys err, AllElemOr xs ys err)\n\n\ntype NotElem x (orig :: [Type]) =\n  TypeError\n    ( 'ShowType x\n        ':<>: 'Text \" not found in \"\n        ':<>: 'ShowType orig\n    )\n\n\ntype family TupleList a where\n  TupleList () = '[]\n  TupleList (a, b) = [a, b]\n  TupleList (a, b, c) = [a, b, c]\n  TupleList (a, b, c, d) = [a, b, c, d]\n  TupleList (a, b, c, d, e) = [a, b, c, d, e]\n  TupleList (a, b, c, d, e, f) = [a, b, c, d, e, f]\n  TupleList (a, b, c, d, e, f, g) = [a, b, c, d, e, f, g]\n  TupleList (a, b, c, d, e, f, g, h) = [a, b, c, d, e, f, g, h]\n  TupleList (a, b, c, d, e, f, g, h, i) = [a, b, c, d, e, f, g, h, i]\n  TupleList (a, b, c, d, e, f, g, h, i, j) = [a, b, c, d, e, f, g, h, i, j]\n  TupleList a = '[a]\n"
  },
  {
    "path": "src/Web/Hyperbole/Types/Client.hs",
    "content": "module Web.Hyperbole.Types.Client where\n\nimport Data.Text (Text)\nimport Web.Hyperbole.Data.Cookie (Cookies)\nimport Web.Hyperbole.Data.QueryData as QueryData\nimport Web.Hyperbole.Types.Request\n\n\ndata Client = Client\n  { requestId :: RequestId\n  , session :: Cookies\n  , query :: Maybe QueryData\n  , pageTitle :: Maybe Text\n  }\n\n\nclientSetPageTitle :: Text -> Client -> Client\nclientSetPageTitle t Client{session, query, requestId} =\n  Client{pageTitle = Just t, session = session, query, requestId}\n\n\nclientModCookies :: (Cookies -> Cookies) -> Client -> Client\nclientModCookies f Client{session, query, requestId, pageTitle} =\n  Client{session = f session, query, requestId, pageTitle}\n\n\nclientSetQuery :: QueryData -> Client -> Client\nclientSetQuery q Client{session, requestId, pageTitle} =\n  Client{query = Just q, session, requestId, pageTitle}\n"
  },
  {
    "path": "src/Web/Hyperbole/Types/Event.hs",
    "content": "module Web.Hyperbole.Types.Event where\n\nimport Data.Aeson (ToJSON)\nimport Data.String.Conversions (cs)\nimport Web.Hyperbole.Data.Encoded\n\n\n-- | Serialized ViewId\nnewtype TargetViewId = TargetViewId {encoded :: Encoded}\n  deriving newtype (ToJSON, Ord, Eq)\n\n\ninstance Show TargetViewId where\n  show (TargetViewId e) = \"TargetViewId \" <> cs (encodedToText e)\n\n\n-- | An action, with its corresponding id\ndata Event id act st = Event\n  { viewId :: id\n  , action :: act\n  , state :: st\n  }\n\n\ninstance (Show act, Show id, Show st) => Show (Event id act st) where\n  show e = \"Event \" <> show e.viewId <> \" \" <> show e.action <> \" \" <> show e.state\n"
  },
  {
    "path": "src/Web/Hyperbole/Types/Request.hs",
    "content": "module Web.Hyperbole.Types.Request where\n\nimport Data.ByteString qualified as BS\nimport Data.ByteString.Lazy qualified as BL\nimport Data.Text (Text)\nimport Network.HTTP.Types (Method)\nimport Web.Hyperbole.Data.Cookie (Cookies)\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.URI (Path, Query)\nimport Web.Hyperbole.Types.Event (Event (..), TargetViewId)\n\n\nnewtype Host = Host {text :: BS.ByteString}\n  deriving (Show)\n\n\ndata Request = Request\n  { host :: Host\n  , path :: Path\n  , query :: Query\n  , body :: BL.ByteString\n  , method :: Method\n  , cookies :: Cookies\n  , event :: Maybe (Event TargetViewId Encoded Encoded)\n  , requestId :: RequestId\n  }\n  deriving (Show)\n\n\nnewtype RequestId = RequestId Text\n  deriving (Show)\n"
  },
  {
    "path": "src/Web/Hyperbole/Types/Response.hs",
    "content": "{-# LANGUAGE LambdaCase #-}\n\nmodule Web.Hyperbole.Types.Response where\n\nimport Data.ByteString.Lazy qualified as BL\nimport Data.String (IsString (..))\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Web.Hyperbole.Data.Encoded (Encoded)\nimport Web.Hyperbole.Data.URI (URI)\nimport Web.Hyperbole.Types.Event\n\n\nnewtype Body = Body BL.ByteString\n\n\ndata ViewUpdate = ViewUpdate {viewId :: TargetViewId, body :: Body}\n\n\n-- | A processed response for the client, which might be a 'ResponseError'\ndata Response\n  = Response ViewUpdate\n  | Redirect URI\n  | Err ResponseError\n\n\ndata ResponseError\n  = NotFound\n  | ErrParse String\n  | ErrQuery String\n  | ErrSession Text String\n  | ErrServer Text\n  | ErrCustom ServerError\n  | ErrInternal\n  | ErrNotHandled (Event TargetViewId Encoded Encoded)\n  | ErrAuth Text\ninstance Show ResponseError where\n  show = \\case\n    NotFound -> \"NotFound\"\n    ErrParse m -> \"ErrParse \" <> cs m\n    ErrQuery m -> \"ErrQuery \" <> cs m\n    ErrSession k m -> \"ErrSession \" <> cs k <> \" \" <> cs m\n    ErrServer m -> \"ErrServer \" <> cs m\n    ErrCustom err -> \"ErrCustom \" <> cs err.message\n    ErrInternal -> \"ErrInternal\"\n    ErrNotHandled ev -> \"ErrNotHandled \" <> show ev\n    ErrAuth m -> \"ErrAuth \" <> cs m\ninstance IsString ResponseError where\n  fromString s = ErrServer (cs s)\n\n\n-- Serialized server error\ndata ServerError = ServerError\n  { message :: Text\n  , body :: Body\n  }\n"
  },
  {
    "path": "src/Web/Hyperbole/View/CSS.hs",
    "content": "module Web.Hyperbole.View.CSS where\n\nimport Web.Atomic.CSS\n\n\n{- | Apply CSS only when a request is in flight. See [Example.Page.Contact](https://docs.hyperbole.live/contacts/1)\n\n@\n#EMBED Example.Contact contactEditView\n@\n-}\nwhenLoading :: (Styleable h) => (CSS h -> CSS h) -> CSS h -> CSS h\nwhenLoading = do\n  descendentOf \"hyp-loading\"\n\n\ndisabled :: (Styleable h) => CSS h -> CSS h\ndisabled =\n  utility\n    \"disabled\"\n    [ \"opacity\" :. \"0.5\"\n    , \"pointer-events\" :. \"none\"\n    ]\n\n\nloading :: (Styleable h) => CSS h -> CSS h\nloading = whenLoading disabled\n"
  },
  {
    "path": "src/Web/Hyperbole/View/Embed.hs",
    "content": "{-# LANGUAGE TemplateHaskell #-}\n\nmodule Web.Hyperbole.View.Embed\n  ( cssEmbed\n  , scriptEmbed\n  , scriptEmbedSourceMap\n  , scriptLiveReload\n  )\nwhere\n\nimport Data.ByteString\nimport Data.FileEmbed\nimport Web.Atomic.CSS.Reset qualified as Atomic\n\n\nscriptEmbed :: ByteString\nscriptEmbed = $(embedFile \"client/dist/hyperbole.js\")\n\n\nscriptEmbedSourceMap :: ByteString\nscriptEmbedSourceMap = $(embedFile \"client/dist/hyperbole.js.map\")\n\n\nscriptLiveReload :: ByteString\nscriptLiveReload = $(embedFile \"client/util/live-reload.js\")\n\n\ncssEmbed :: ByteString\ncssEmbed =\n  Atomic.cssResetEmbed\n    <> \"\\n\"\n    <> intercalate\n      \"\\n\"\n      [\"form, label { display: flex; flex-direction: column } \"]\n"
  },
  {
    "path": "src/Web/Hyperbole/View/Render.hs",
    "content": "module Web.Hyperbole.View.Render\n  ( renderText\n  , renderLazyByteString\n  , renderBody\n  ) where\n\nimport Data.ByteString.Lazy qualified as BL\nimport Data.Text (Text)\nimport Web.Atomic.Render qualified as Atomic\nimport Web.Hyperbole.Types.Response (Body (..))\nimport Web.Hyperbole.View.Types (View, execView)\n\n\nrenderText :: View () () -> Text\nrenderText = Atomic.renderText . execView () ()\n\n\nrenderLazyByteString :: View () () -> BL.ByteString\nrenderLazyByteString = Atomic.renderLazyByteString . execView () ()\n\n\nrenderBody :: View () () -> Body\nrenderBody v = Body $ renderLazyByteString v\n"
  },
  {
    "path": "src/Web/Hyperbole/View/Tag.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Web.Hyperbole.View.Tag where\n\nimport Control.Monad (forM_)\nimport Data.ByteString (ByteString)\nimport Data.String.Conversions (cs)\nimport Data.Text (Text, pack)\nimport Data.Text qualified as T\nimport Effectful\nimport Effectful.State.Dynamic\nimport Web.Atomic.CSS\nimport Web.Atomic.Html qualified as Atomic\nimport Web.Atomic.Types\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.View.Types\n\n\n-- Html ---------------------------------------------\n\ntag :: Text -> View c () -> View c ()\ntag = tag' False\n\n\ntag' :: Bool -> Text -> View c () -> View c ()\ntag' inline n (View eff) = View $ do\n  inner <- eff\n  pure $ Atomic.tag' inline n inner\n\n\ntext :: Text -> View c ()\ntext t = View $ pure $ Atomic.text t\n\n\nnone :: View c ()\nnone = View $ pure Atomic.none\n\n\nraw :: Text -> View c ()\nraw t = View $ pure $ Atomic.raw t\n\n\n---\n\nel :: View c () -> View c ()\nel = tag \"div\"\n\n\nrow :: View c () -> View c ()\nrow = tag \"div\" ~ flexRow\n\n\ncol :: View c () -> View c ()\ncol = tag \"div\" ~ flexCol\n\n\nspace :: View c ()\nspace = tag \"div\" none ~ grow\n\n\npre :: Text -> View c ()\npre t = tag \"pre\" (text t)\n\n\ncode :: Text -> View c ()\ncode t = tag \"code\" (text t)\n\n\n-- | A hyperlink to the given url\nlink :: URI -> View c () -> View c ()\nlink u = tag' True \"a\" @ att \"href\" (uriToText u)\n\n\nimg :: Text -> View c ()\nimg sc = tag \"img\" @ src sc $ none\n\n\n-- * Inputs\n\n\n-- basic forms. See Web.Hyperbole.View.Forms\nform :: View c () -> View c ()\nform = tag \"form\"\n\n\ninput :: View c ()\ninput = tag \"input\" @ att \"type\" \"text\" $ none\n\n\nname :: (Attributable h) => Text -> Attributes h -> Attributes h\nname = att \"name\"\n\n\nvalue :: (Attributable h) => Text -> Attributes h -> Attributes h\nvalue = att \"value\"\n\n\nlabel :: View c () -> View c ()\nlabel = tag \"label\"\n\n\nplaceholder :: (Attributable h) => Text -> Attributes h -> Attributes h\nplaceholder = att \"placeholder\"\n\n\nautofocus :: (Attributable h) => Attributes h -> Attributes h\nautofocus = att \"autofocus\" \"\"\n\n\n-- * Document Metadata\n\n\n-- html :: View c () -> View c ()\n-- html = tag \"html\"\n\n-- head :: View c () -> View c ()\n-- head = tag \"head\"\n\n-- body :: View c () -> View c ()\n-- body = tag \"body\"\n\nmeta :: View c ()\nmeta = tag \"meta\" none\n\n\ntitle :: Text -> View c ()\ntitle = tag \"title\" . text\n\n\ncontent :: (Attributable h) => Text -> Attributes h -> Attributes h\ncontent = att \"content\"\n\n\nhttpEquiv :: (Attributable h) => Text -> Attributes h -> Attributes h\nhttpEquiv = att \"httpEquiv\"\n\n\ncharset :: (Attributable h) => Text -> Attributes h -> Attributes h\ncharset = att \"charset\"\n\n\ntype_ :: (Attributable h) => Text -> Attributes h -> Attributes h\ntype_ = att \"type\"\n\n\nsrc :: (Attributable h) => Text -> Attributes h -> Attributes h\nsrc = att \"src\"\n\n\nscript :: Text -> View c ()\nscript sc = tag \"script\" none @ src sc\n\n\n-- | Embed raw script, escape '</script>'\nscript' :: ByteString -> View c ()\nscript' dat = tag' True \"script\" $ raw $ T.replace \"</\" \"\\\\u003C/\" $ cs dat\n\n\nstyle :: ByteString -> View c ()\nstyle cnt = tag \"style\" (raw $ cs cnt) @ type_ \"text/css\"\n\n\nstylesheet :: Text -> View c ()\nstylesheet href = tag \"link\" @ att \"rel\" \"stylesheet\" . att \"href\" href $ none\n\n\n-- * Navigation\n\n\nnav :: View c () -> View c ()\nnav = tag \"nav\"\n\n\n-- * Tables\n\n\n{- | Create a type safe data table by specifying columns\n\n> data User = User {name :: Text, email :: Text}\n>\n> usersTable :: [User] -> View c ()\n> usersTable us = do\n>   table us $ do\n>     tcol (th \"Name\" ~ hd) $ \\u -> td ~ cell $ text u.name\n>     tcol (th \"Email\" ~ hd) $ \\u -> td ~ cell $ text u.email\n>  where\n>   hd = cell . bold\n>   cell :: (Styleable h) => CSS h -> CSS h\n>   cell = pad 4 . border 1\n-}\ntable :: [dt] -> TableColumns c dt () -> View c ()\ntable dts (TableColumns wcs) = do\n  let cols = runPureEff . execStateLocal [] $ wcs\n  tag \"table\" $ do\n    tag \"thead\" $ do\n      tag \"tr\" $ do\n        forM_ cols $ \\tc -> do\n          let TableHead hd = tc.headCell\n          hd\n    tag \"tbody\" $ do\n      forM_ dts $ \\dt -> do\n        tag \"tr\" $ do\n          forM_ cols $ \\tc -> do\n            tc.dataCell dt\n\n\nusersTable :: View c ()\nusersTable = do\n  table items $ do\n    tcol (th \"Index\" ~ bold) $ \\u -> td ~ cell $ text $ pack $ show $ fst u\n    tcol (th \"Item\" ~ bold) $ \\u -> td ~ cell $ text $ snd u\n where\n  items :: [(Int, Text)]\n  items = zip [0 ..] [\"one\", \"two\", \"three\"]\n  cell :: (Styleable h) => CSS h -> CSS h\n  cell = pad 4 . border 1\n\n\nnewtype Table c a = Table (View c a)\n  deriving newtype (Functor, Applicative, Monad, Styleable)\n\n\ntcol :: forall dt c. TableHead c () -> (dt -> View c ()) -> TableColumns c dt ()\ntcol hd cell = TableColumns $ do\n  modify @[TableColumn c dt] $ \\cols -> cols <> [TableColumn hd cell]\n\n\nth :: View c () -> TableHead c ()\nth cnt = do\n  TableHead $ tag \"th\" cnt\n\n\ntd :: View c () -> View c ()\ntd = tag \"td\"\n\n\ninstance {-# OVERLAPS #-} Styleable (TableColumns c dt () -> View c ()) where\n  modCSS frr parent eff = modCSS frr (parent eff)\n\n\nnewtype TableHead id a = TableHead (View id a)\n  deriving newtype (Functor, Applicative, Monad, Styleable)\n\n\nnewtype TableColumns c dt a = TableColumns (Eff '[State [TableColumn c dt]] a)\n  deriving newtype (Functor, Applicative, Monad)\n\n\ndata TableColumn c dt = TableColumn\n  { headCell :: TableHead c ()\n  , dataCell :: dt -> View c ()\n  }\n\n\n-- * Lists\n\n\n{- | List elements do not include any inherent styling but are useful for accessibility. See 'Web.Atomic.CSS.list'.\n\n> ol id $ do\n>  let nums = list Decimal\n>  li nums \"one\"\n>  li nums \"two\"\n>  li nums \"three\"\n-}\nol :: ListItem c () -> View c ()\nol (ListItem cnt) = do\n  tag \"ol\" cnt\n\n\nul :: ListItem c () -> View c ()\nul (ListItem cnt) = do\n  tag \"ul\" cnt\n\n\nli :: View c () -> ListItem c ()\nli cnt = ListItem $ do\n  tag \"li\" cnt\n\n\nnewtype ListItem c a = ListItem (View c a)\n  deriving newtype (Functor, Applicative, Monad, Styleable)\n"
  },
  {
    "path": "src/Web/Hyperbole/View/Types.hs",
    "content": "{-# LANGUAGE AllowAmbiguousTypes #-}\n\nmodule Web.Hyperbole.View.Types where\n\nimport Data.String (IsString (..))\nimport Data.Text (Text, pack)\nimport Effectful\nimport Effectful.Reader.Dynamic\nimport Effectful.State.Dynamic\nimport GHC.Generics\nimport Web.Atomic.Html (Html (..))\nimport Web.Atomic.Html qualified as Atomic\nimport Web.Atomic.Types\nimport Web.Hyperbole.Data.Encoded (decodeEither, encodedToText)\nimport Web.Hyperbole.Data.Param (FromParam, ToParam (..))\nimport Web.Hyperbole.View.ViewId\n\n\n-- View ------------------------------------------------------------\n\n{- | 'View's are HTML fragments with a 'context'\n\n@\n#EMBED Example.Docs.BasicPage helloWorld\n@\n-}\nnewtype View c a = View {html :: Eff '[Reader (c, ViewState c)] (Html a)}\n\n\ninstance IsString (View c ()) where\n  fromString s = View $ pure $ Atomic.text (pack s)\n\n\nexecView :: forall c a. c -> ViewState c -> View c a -> Html a\nexecView c st (View eff) = do\n  runPureEff $ runReader (c, st) eff\n\n\ninstance Functor (View c) where\n  fmap f (View eff) = View $ do\n    html <- eff\n    pure $ fmap f html\ninstance Applicative (View ctx) where\n  pure a = View $ pure $ pure a\n  liftA2 :: (a -> b -> c) -> View ctx a -> View ctx b -> View ctx c\n  liftA2 abc (View va) (View vb) = View $ do\n    ha <- va\n    hb <- vb\n    pure $ liftA2 abc ha hb\n  View va *> View vb = View $ do\n    ha <- va\n    hb <- vb\n    pure $ ha *> hb\ninstance Monad (View ctx) where\n  (>>) = (*>)\n  (>>=) :: forall a b. View ctx a -> (a -> View ctx b) -> View ctx b\n  -- TEST: appending Empty\n  View ea >>= famb = View $ do\n    ha <- ea\n    let View eb = famb ha.value\n    (ha >>) <$> eb\n\n\n-- Context -----------------------------------------\n\n-- type family ViewContext (v :: Type) where\n--   ViewContext (View c x) = c\n--   ViewContext (View c x -> View c x) = c\n\nnewtype ChildView a = ChildView a\n  deriving (Generic)\ninstance (ViewId a, FromParam a, ToParam a) => ViewId (ChildView a) where\n  type ViewState (ChildView a) = ViewState a\n\n\n-- TEST: appending Empty\ncontext :: forall c. View c (c, ViewState c)\ncontext = View $ do\n  c <- ask @(c, ViewState c)\n  pure $ pure c\n\n\nviewState :: View c (ViewState c)\nviewState = snd <$> context\n\n\nrunViewContext :: ctx -> ViewState ctx -> View ctx () -> View c ()\nrunViewContext c st (View eff) = View $ do\n  pure $ runPureEff $ runReader (c, st) eff\n\n\nrunChildView :: (ViewState ctx ~ ViewState c) => (c -> ctx) -> View ctx () -> View c ()\nrunChildView f v = do\n  st <- viewState\n  c <- viewId\n  runViewContext (f c) st v\n\n\n-- modifyContext\n--   :: forall ctx0 ctx1. (ctx0 -> ctx1) -> View ctx1 () -> View ctx0 ()\n-- modifyContext f (View eff) = View $ do\n--   ctx0 <- ask @ctx0\n--   pure $ runPureEff $ runReader (f ctx0) eff\n\n-- Attributes -----------------------------------------\n\ninstance Attributable (View c a) where\n  modAttributes f (View eff) = View $ do\n    h <- eff\n    pure $ modAttributes f h\n\n\ninstance Styleable (View c a) where\n  modCSS f (View eff) = View $ do\n    h <- eff\n    pure $ modCSS f h\n\n\n{- | Access the 'viewId' in a 'View' or 'update'\n\n@\n#EMBED Example.Concurrency.LazyLoading data LazyData\n\n#EMBED Example.Concurrency.LazyLoading instance (Debug :> es, GenRandom :> es) => HyperView LazyData es where\n@\n-}\nclass HasViewId m view where\n  viewId :: m view\n\n\ninstance HasViewId (View ctx) ctx where\n  viewId = fst <$> context\ninstance (ViewState view ~ st) => HasViewId (Eff (Reader view : State st : es)) view where\n  viewId = ask\n\n\nencodeViewId :: (ViewId id) => id -> Text\nencodeViewId = encodedToText . toViewId\n\n\ndecodeViewId :: (ViewId id) => Text -> Maybe id\ndecodeViewId t = do\n  case parseViewId =<< decodeEither t of\n    Left _ -> Nothing\n    Right a -> pure a\n"
  },
  {
    "path": "src/Web/Hyperbole/View/ViewAction.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n\nmodule Web.Hyperbole.View.ViewAction where\n\nimport Data.Text (Text)\nimport GHC.Generics\nimport Web.Hyperbole.Data.Encoded as Encoded\n\n\n{- | Define every action possible for a given 'HyperView'\n\n@\n#EMBED Example.Simple instance HyperView Message\n@\n-}\nclass ViewAction a where\n  toAction :: a -> Encoded\n  default toAction :: (Generic a, GToEncoded (Rep a)) => a -> Encoded\n  toAction = genericToEncoded\n\n\n  parseAction :: Encoded -> Either String a\n  default parseAction :: (Generic a, GFromEncoded (Rep a)) => Encoded -> Either String a\n  parseAction = genericParseEncoded\n\n\ninstance ViewAction () where\n  toAction _ = mempty\n  parseAction _ = pure ()\n\n\nencodeAction :: (ViewAction act) => act -> Text\nencodeAction = encodedToText . toAction\n\n\ndecodeAction :: (ViewAction act) => Text -> Maybe act\ndecodeAction t = do\n  case parseAction =<< encodedParseText t of\n    Left _ -> Nothing\n    Right a -> pure a\n"
  },
  {
    "path": "src/Web/Hyperbole/View/ViewId.hs",
    "content": "{-# LANGUAGE DefaultSignatures #-}\n\nmodule Web.Hyperbole.View.ViewId where\n\nimport Data.Kind (Type)\nimport GHC.Generics\nimport Web.Hyperbole.Data.Encoded as Encoded\n\n\n{- | A unique identifier for a 'HyperView'\n\n@\n#EMBED Example.Simple data Message\n@\n-}\nclass ViewId a where\n  type ViewState a :: Type\n  type ViewState a = ()\n\n\n  toViewId :: a -> Encoded\n  default toViewId :: (Generic a, GToEncoded (Rep a)) => a -> Encoded\n  toViewId = genericToEncoded\n\n\n  parseViewId :: Encoded -> Either String a\n  default parseViewId :: (Generic a, GFromEncoded (Rep a)) => Encoded -> Either String a\n  parseViewId = genericParseEncoded\n\n\ninstance ViewId () where\n  toViewId _ = mempty\n  parseViewId _ = pure ()\n"
  },
  {
    "path": "src/Web/Hyperbole/View.hs",
    "content": "module Web.Hyperbole.View\n  ( module Web.Hyperbole.View.Types\n  , module Web.Hyperbole.View.ViewId\n  , module Web.Hyperbole.View.ViewAction\n  , module Web.Hyperbole.View.Embed\n  , module Web.Hyperbole.View.Render\n  , module Web.Hyperbole.View.Tag\n  , module Web.Hyperbole.View.CSS\n  , module Web.Atomic.Attributes\n  ) where\n\nimport Web.Atomic.Attributes\nimport Web.Hyperbole.View.CSS\nimport Web.Hyperbole.View.Embed\nimport Web.Hyperbole.View.Render\nimport Web.Hyperbole.View.Tag hiding (form, input, label)\nimport Web.Hyperbole.View.Types\nimport Web.Hyperbole.View.ViewAction\nimport Web.Hyperbole.View.ViewId\n\n"
  },
  {
    "path": "src/Web/Hyperbole.hs",
    "content": "{- |\nModule:      Web.Hyperbole\nCopyright:   (c) 2024 Sean Hess\nLicense:     BSD3\nMaintainer:  Sean Hess <seanhess@gmail.com>\nStability:   experimental\nPortability: portable\n\nCreate fully interactive HTML applications with type-safe serverside Haskell. Inspired by [HTMX](https://htmx.org/), [Elm](https://elm-lang.org/), and [Phoenix LiveView](https://www.phoenixframework.org/)\n\n* [hyperbole.live](https://hyperbole.live) - documentation and examples\n* [github](https://github.com/seanhess/hyperbole) - issues and source code\n-}\nmodule Web.Hyperbole\n  ( -- * Application #application#\n    liveApp\n  , Warp.run\n\n    -- ** Page\n  , Page\n  , runPage\n\n    -- ** Document\n  , document\n  , quickStartDocument\n  , DocumentHead\n  , quickStart\n  , mobileFriendly\n\n    -- ** Type-Safe Routes #routes#\n  , Route (..)\n  , routeRequest -- maybe belongs in an application section\n  , routeUri\n  , route\n\n    -- * Hyperbole Effect #hyperbole-effect#\n  , Hyperbole\n\n    -- ** Request #request#\n  , request\n  , Request (..)\n\n    -- ** Response #response#\n  , respondError\n  , respondErrorView\n  , notFound\n  , redirect\n\n    -- ** Query #query#\n    -- $query\n  , ToQuery (..)\n  , FromQuery (..)\n  , query\n  , setQuery\n  , modifyQuery\n  , clearQuery\n  , param\n  , lookupParam\n  , setParam\n  , deleteParam\n  , queryParams\n\n    -- ** Sessions #sessions#\n    -- $sessions\n  , Session (..)\n  , session\n  , saveSession\n  , lookupSession\n  , modifySession\n  , modifySession_\n  , deleteSession\n\n    -- ** Control Client #client#\n  , pageTitle\n  , trigger\n  , pushEvent\n  , pushUpdate\n\n    -- * HyperView #hyperview#\n  , HyperView (..)\n  , hyper\n  , hyperState\n  , HasViewId (..)\n\n    -- * Interactive Elements #interactive#\n  , button\n  , search\n  , dropdown\n  , option\n  , Option\n\n    -- * Events\n  , onClick\n  , onDblClick\n  , onMouseEnter\n  , onMouseLeave\n  , onInput\n  , onLoad\n  , DelayMs\n  , onKeyDown\n  , onKeyUp\n  , Key (..)\n\n    -- * Type-Safe Forms #forms#\n    -- $forms\n  , FromForm (..)\n  , FromFormF (..)\n  , formData\n  , GenFields (..)\n  , fieldNames\n  , FieldName (..)\n  , FormFields\n  -- , FormField (..)\n  , Field\n  , Identity\n\n    -- ** Form View\n  , form\n  , field\n  , label\n  , input\n  , checkbox\n  , radioGroup\n  , radio\n  , select\n  , checked\n  , textarea\n  , submit\n  , View.placeholder\n  , InputType (..)\n\n    -- ** Validation\n  , Validated (..)\n  , isInvalid\n  , validate\n  , invalidText\n\n    -- * Query Param Encoding #query-param#\n  , QueryData\n  , ToParam (..)\n  , FromParam (..)\n  , ToEncoded\n  , FromEncoded\n\n    -- * Advanced #advanced#\n  , target\n  , Response\n  , Root\n  , ConcurrencyMode (..)\n\n    -- * Exports #exports#\n\n    -- ** View\n  , View (..)\n  , module View\n\n    -- ** Embeds\n\n    -- | Embedded CSS and Javascript to include in your document function. See 'quickStartDocument'\n  , module Web.Hyperbole.View.Embed\n\n    -- ** Effectful\n    -- $effects\n  , module Effectful\n\n    -- ** Other\n  , URI (..)\n  , uri\n  , Application\n  , module GHC.Generics\n  , Default (..)\n  , ToJSON\n  , FromJSON\n  ) where\n\nimport Data.Aeson (FromJSON, ToJSON)\nimport Data.Default\nimport Effectful (Eff, (:>))\nimport GHC.Generics (Generic, Rep)\nimport Network.Wai (Application)\nimport Network.Wai.Handler.Warp as Warp (run)\nimport Web.Atomic.CSS ()\nimport Web.Atomic.Types ()\nimport Web.Hyperbole.Application\nimport Web.Hyperbole.Data.Encoded (FromEncoded, ToEncoded)\nimport Web.Hyperbole.Data.Param\nimport Web.Hyperbole.Data.QueryData\nimport Web.Hyperbole.Document\nimport Web.Hyperbole.Effect.Client\nimport Web.Hyperbole.Effect.Hyperbole\nimport Web.Hyperbole.Effect.Query\nimport Web.Hyperbole.Effect.Request\nimport Web.Hyperbole.Effect.Response\nimport Web.Hyperbole.Effect.Session\nimport Web.Hyperbole.HyperView\nimport Web.Hyperbole.HyperView.Forms\nimport Web.Hyperbole.Page (Page, runPage)\nimport Web.Hyperbole.Route\nimport Web.Hyperbole.Types.Request\nimport Web.Hyperbole.Types.Response\nimport Web.Hyperbole.View hiding (placeholder)\nimport Web.Hyperbole.View qualified as View hiding (Attributable, Attributes, View)\nimport Web.Hyperbole.View.Embed\n\n\n{- $documentation\n\nPlease visit https://hyperbole.live for documentation and examples\n-}\n\n-- TODO: NSO link\n"
  },
  {
    "path": "test/Spec.hs",
    "content": "import Skeletest.Main\n\n"
  },
  {
    "path": "test/Test/EncodedSpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.EncodedSpec where\n\nimport Data.Aeson (FromJSON (..), ToJSON (..), Value (..))\nimport Data.Text (Text)\nimport GHC.Generics (Generic)\nimport Skeletest\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.Param\n\n\n-- TEST: QueryData underscores vs spaces\n\ndata One = One\n  -- toJSON automatically delegates to the child's ToJSON instance\n  -- when it ought to be enought to delegate to the Generic instance!\n  deriving (Generic, Eq, ToEncoded, FromEncoded, ToParam, FromParam)\n\n\ndata Tag = A | B | C | D\n  deriving (Generic, Eq, ToEncoded, ToParam, FromParam)\n\n\ndata Two = Two | Two2 Int\n  deriving (Generic, Eq, ToJSON, FromJSON, ToEncoded, FromEncoded)\n\n\n-- Custom Param Encoding\ninstance ToParam Two where\n  toParam Two = \"Two\"\n  toParam other = genericToParam other\ninstance FromParam Two where\n  parseParam \"Two\" = pure Two\n  parseParam other = genericParseParam other\n\n\ndata Sum\n  = Sumthing\n  | Num Int\n  | Str Text\n  | COne One\n  | CTwo Two\n  | List [Text]\n  deriving (Generic, Eq, ToEncoded, FromEncoded)\n\n\ndata Nested\n  = Gogo One\n  | RecordN Record\n  | RecordEx Record Int\n  | Tag Tag\n  deriving (Generic, ToEncoded, FromEncoded, Eq)\n\n\ndata Product\n  = Product Text Int Bool\n  deriving (Generic, Eq, ToEncoded, FromEncoded)\n\n\ndata Record = Record\n  { one :: Int\n  , two :: Text\n  }\n  deriving (Generic, Show, ToJSON, FromJSON, Eq, ToEncoded, FromEncoded, ToParam, FromParam)\n\n\ndata Product4 = Product4 Text Text Text Text deriving (Generic, Show, Eq, Read, FromEncoded, ToEncoded)\n\n\nspec :: Spec\nspec = withMarkers [\"encoded\"] $ do\n  describe \"genericToEncoded\" $ do\n    it \"should encode single tags\" $ do\n      genericToEncoded One `shouldBe` Encoded \"One\" []\n\n    it \"should encode multi tags\" $ do\n      genericToEncoded Two `shouldBe` Encoded \"Two\" []\n      genericToEncoded (Two2 3) `shouldBe` Encoded \"Two2\" [jsonParam $ Number 3]\n      genericToEncoded (Gogo One) `shouldBe` Encoded \"Gogo\" [toParam One]\n\n    it \"should encode sum tags\" $ do\n      genericToEncoded (CTwo Two) `shouldBe` Encoded \"CTwo\" [toParam Two]\n\n    it \"basic\" $ do\n      genericToEncoded (Gogo One) `shouldBe` Encoded \"Gogo\" [toParam One]\n\n    it \"product\" $ do\n      genericToEncoded (Product \"one\" 2 True) `shouldBe` Encoded \"Product\" [toParam @Text \"one\", toParam @Int 2, toParam True]\n\n    it \"product4\" $ do\n      let prod = Product4 \"one\" \"two\" \"three\" \"four\"\n      genericToEncoded prod `shouldBe` Encoded \"Product4\" (fmap toParam [\"one\" :: Text, \"two\", \"three\", \"four\"])\n\n  describe \"genericParseEncoded\" $ do\n    it \"product4\" $ do\n      genericParseEncoded (Encoded \"Product4\" (fmap toParam [\"one\" :: Text, \"two\", \"three\", \"four\"])) `shouldBe` Right (Product4 \"one\" \"two\" \"three\" \"four\")\n\n    it \"sum\" $ do\n      genericParseEncoded @Sum (Encoded \"Sumthing\" []) `shouldBe` Right Sumthing\n      genericParseEncoded @Sum (Encoded \"Num\" [toParam @Int 2]) `shouldBe` Right (Num 2)\n      genericParseEncoded @Sum (Encoded \"Str\" [toParam @Text \"OK\"]) `shouldBe` Right (Str \"OK\")\n\n      genericParseEncoded @Sum (Encoded \"COne\" [toParam One]) `shouldBe` Right (COne One)\n      genericParseEncoded @Sum (Encoded \"CTwo\" [toParam Two]) `shouldBe` Right (CTwo Two)\n\n  describe \"toEncoded\" $ do\n    it \"encodes numbers as text\" $ do\n      -- no, this is right, but when we go to decode, we pick up the json instance...\n      toEncoded (Num 1) `shouldBe` Encoded \"Num\" [jsonParam $ Number 1]\n\n  describe \"toText\" $ do\n    it \"should encode single tags\" $ do\n      encodedToText (Encoded \"One\" []) `shouldBe` \"One\"\n\n  describe \"parseText\" $ do\n    it \"should decode single tags\" $ do\n      encodedParseText \"One\" `shouldBe` Right (Encoded \"One\" [])\n\n    it \"parses numbers\" $ do\n      encodedParseText \"Num 1\" `shouldBe` Right (Encoded \"Num\" [jsonParam $ Number 1])\n\n  describe \"encode\" $ do\n    it \"should encode single tags\" $ do\n      encode One `shouldBe` \"One\"\n\n    it \"encodes strings\" $ do\n      encode (Str \"hello world\") `shouldBe` \"Str hello_world\"\n      -- but then how is it going to know the difference between the two?\n      encode (Str \" \") `shouldBe` \"Str _\"\n      encode (Str \"\") `shouldBe` \"Str |\"\n      encode (Str \"_\") `shouldBe` \"Str \\\\_\"\n      encode (Str \"\\n\") `shouldBe` \"Str \\\\n\"\n      encode (Str \"hello_world\") `shouldBe` \"Str hello\\\\_world\"\n      encode (Str \"hello+world\") `shouldBe` \"Str hello+world\"\n      encode (Str \"hello\\nworld\") `shouldBe` \"Str hello\\\\nworld\"\n\n    it \"should encode records`\" $ do\n      -- no field names for ourselves\n      encode (Record 1 \"two\") `shouldBe` \"Record 1 two\"\n      -- but if it is nested it uses the JSON instance, obviously\n      let r2 = Record 1 \"two\"\n      encode (RecordN r2) `shouldBe` \"RecordN \" <> encodeParam (jsonParam r2)\n\n    it \"no special case for nested constructors`\" $ do\n      encode A `shouldBe` \"A\"\n      encode (Tag A) `shouldBe` \"Tag A\"\n\n    it \"should encode sum\" $ do\n      encode (Num 1) `shouldBe` \"Num 1\"\n      encode (Str \"hello world\") `shouldBe` \"Str hello_world\"\n\n    it \"should encode prodcuts\" $ do\n      encode (Product \"hello world\" 2 True) `shouldBe` \"Product hello_world 2 true\"\n\n    it \"encodes more constructors\" $ do\n      encode (CTwo (Two2 3)) `shouldBe` \"CTwo [\\\"Two2\\\",3]\"\n      encode (CTwo Two) `shouldBe` \"CTwo Two\" -- uses the custom toparam instance\n      encode (COne One) `shouldBe` \"COne []\"\n\n  describe \"decode\" $ do\n    it \"should encode single tags\" $ do\n      decode \"One\" `shouldBe` Just One\n\n    it \"should decode nested sum\" $ do\n      decodeEither \"Num 1\" `shouldBe` Right (Num 1)\n      decodeEither \"Str str\" `shouldBe` Right (Str \"str\")\n      decodeEither \"Str hello_world\" `shouldBe` Right (Str \"hello world\")\n\n    it \"no special case for nested constructors`\" $ do\n      decode \"Tag A\" `shouldBe` Just (Tag A)\n\n    it \"decodes strings\" $ do\n      decode \"Str |\" `shouldBe` pure (Str \"\")\n\n  describe \"params\" $ do\n    it \"sanitizeText\" $ do\n      encodeParam \"hello world\" `shouldBe` \"hello_world\"\n      encodeParam \"hello_world\" `shouldBe` \"hello\\\\_world\"\n      encodeParam \"hello\\nworld\" `shouldBe` \"hello\\\\nworld\"\n\n    it \"desanitizeText\" $ do\n      decodeParam \"hello_world\" `shouldBe` \"hello world\"\n      decodeParam \"hello\\\\_world\" `shouldBe` \"hello_world\"\n      decodeParam \"hello\\\\nworld\" `shouldBe` \"hello\\nworld\"\n\n    -- TODO: Add more edge cases to check if \"\\n\" is escaped properly.\n    it \"edge cases\" $ do\n      encodeParam \"\" `shouldBe` \"|\"\n      encodeParam \" \" `shouldBe` \"_\"\n      encodeParam \"  \" `shouldBe` \"__\"\n\n      encodeParam \"_\" `shouldBe` \"\\\\_\"\n      encodeParam \"__\" `shouldBe` \"\\\\_\\\\_\"\n\n      decodeParam \"|\" `shouldBe` \"\"\n      decodeParam \"_\" `shouldBe` \" \"\n      decodeParam \"\\\\_\" `shouldBe` \"_\"\n      decodeParam \"\\\\_\\\\_\" `shouldBe` \"__\"\n\n  describe \"round trip\" $ do\n    it \"records\" $ do\n      let enc = genericToEncoded (Record 1 \"two\")\n      genericParseEncoded enc `shouldBe` Right (Record 1 \"two\")\n\n    it \"product\" $ do\n      decode (encode (Product \"hello world\" 2 False)) `shouldBe` Just (Product \"hello world\" 2 False)\n      decode (encode (Product \"bob\" (-2) True)) `shouldBe` Just (Product \"bob\" (-2) True)\n\n    it \"nested product with records\" $ do\n      let r = RecordEx (Record 2 \"three\") 33\n      let t = encode r\n      decode t `shouldBe` Just r\n\n    it \"special case constructors\" $ do\n      decode (encode (CTwo Two)) `shouldBe` Just (CTwo Two)\n      decode (encode (Tag B)) `shouldBe` Just (Tag B)\n\n    it \"big product\" $ do\n      let p = Product4 \"hello world\" \"two_times\" \"three\" \"four\"\n      decode (encode p) `shouldBe` Just p\n\n    it \"empty strings\" $ do\n      decode (encode $ Str \"\") `shouldBe` Just (Str \"\")\n\n    it \"special characters\" $ do\n      let str = \"hello+world \\\"bob_lives\\\"\"\n      decode (encode $ Str str) `shouldBe` Just (Str str)\n\n    it \"encodes lists`\" $ do\n      let l = List [\"hello, world\", \"\", \"+,|<[]\"]\n      print $ encode l\n      decode @Sum (encode l) `shouldBe` Just l\n\n    -- Regression tests for https://github.com/seanhess/hyperbole/issues/187\n    -- A ViewId (or state) containing a list with newline characters must\n    -- encode/decode correctly.  Previously, desanitizeParamText blindly\n    -- replaced the JSON escape sequence \"\\\\n\" with a real newline, corrupting\n    -- the JSON and causing \"No Handler for Event viewId\".\n    it \"list with newline character round-trips correctly (issue #187)\" $ do\n      decode @Sum (encode (List [\"\\n\"])) `shouldBe` Just (List [\"\\n\"])\n\n    it \"list with newline in multiple elements\" $ do\n      decode @Sum (encode (List [\"\\n\", \"hello\\nworld\", \"plain\"])) `shouldBe` Just (List [\"\\n\", \"hello\\nworld\", \"plain\"])\n\n    it \"strings\" $ do\n      decode @Sum (encode (Str \"\")) `shouldBe` pure (Str \"\")\n      decode @Sum (encode (Str \" \")) `shouldBe` pure (Str \" \")\n      decode @Sum (encode (Str \"_\")) `shouldBe` pure (Str \"_\")\n      decode @Sum (encode (Str \"~\")) `shouldBe` pure (Str \"~\")\n      decode @Sum (encode (Str \"+\")) `shouldBe` pure (Str \"+\")\n      decode @Sum (encode (Str \"hello world\")) `shouldBe` pure (Str \"hello world\")\n      decode @Sum (encode (Str \"hello_world\")) `shouldBe` pure (Str \"hello_world\")\n"
  },
  {
    "path": "test/Test/FormSpec.hs",
    "content": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.FormSpec where\n\nimport Data.Text (Text)\nimport Skeletest\nimport Web.Hyperbole.HyperView.Forms\n\n\ndata Example f = Example\n  { message :: Field f Text\n  , age :: Field f Int\n  , whatever :: Field f (Maybe Float)\n  , maybeMessage :: Field f (Maybe Text)\n  }\n  deriving (Generic, FromFormF, GenFields Maybe)\ninstance Show (Example Identity) where\n  show (Example m a w mm) = \"Example \" <> show m <> \" \" <> show a <> \" \" <> show w <> \" \" <> show mm\ninstance Eq (Example Identity) where\n  Example m a w mm == Example m2 a2 w2 mm2 = m == m2 && a == a2 && w == w2 && mm == mm2\n\n\ndata Flags = Flags\n  { a :: Bool\n  , b :: Bool\n  }\n  deriving (Generic, FromForm, Show, Eq)\n\n\ndata Todo = Todo\n  {msg :: Text}\n  deriving (Generic, FromForm, Show, Eq)\n\n\nspec :: Spec\nspec = withMarkers [\"param\"] $ do\n  describe \"forms\" $ do\n    it \"should parse a form\" $ do\n      case fromForm @(Example Identity) [(\"message\", \"hello\"), (\"age\", \"23\"), (\"whatever\", \"\")] of\n        Left e -> fail $ show e\n        Right a -> do\n          a.message `shouldBe` \"hello\"\n          a.age `shouldBe` 23\n          a.whatever `shouldBe` Nothing\n\n    it \"should parse a form with a number for the text\" $ do\n      let res = fromForm @(Example Identity) [(\"message\", \"30\"), (\"age\", \"0\"), (\"whatever\", \"2\"), (\"maybeMessage\", \"hello\")]\n      res `shouldBe` Right (Example \"30\" 0 (Just 2) (Just \"hello\"))\n\n    it \"parses missing Maybes\" $ do\n      let res = fromForm @(Example Identity) [(\"message\", \"30\"), (\"age\", \"0\")]\n      res `shouldBe` Right (Example \"30\" 0 Nothing Nothing)\n\n    it \"parses Maybe Text empty string\" $ do\n      let res = fromForm @(Example Identity) [(\"message\", \"30\"), (\"age\", \"0\"), (\"maybeMessage\", \"\")]\n      res `shouldBe` Right (Example \"30\" 0 Nothing (Just \"\"))\n\n    it \"parses weird\" $ do\n      fromForm @Flags [(\"a\", \"true\"), (\"b\", \"off\")] `shouldBe` Right (Flags True False)\n      fromForm @Flags [(\"a\", \"on\"), (\"b\", \"false\")] `shouldBe` Right (Flags True False)\n      fromForm @Flags [(\"a\", \"on\")] `shouldBe` Right (Flags True False)\n\n    it \"parses missing bools as false\" $ do\n      fromForm @Flags [(\"a\", \"true\")] `shouldBe` Right (Flags True False)\n\n    it \"parses underscores\" $ do\n      fromForm @Todo [(\"msg\", \"test\")] `shouldBe` Right (Todo \"test\")\n      fromForm @Todo [(\"msg\", \"hello world\")] `shouldBe` Right (Todo \"hello world\")\n      fromForm @Todo [(\"msg\", \"hello+world\")] `shouldBe` Right (Todo \"hello+world\")\n      fromForm @Todo [(\"msg\", \"hello_world\")] `shouldBe` Right (Todo \"hello_world\")\n"
  },
  {
    "path": "test/Test/ParamSpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.ParamSpec where\n\nimport Data.Aeson\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport GHC.Generics\nimport Skeletest\nimport Web.Hyperbole.Data.Param\n\n\nspec :: Spec\nspec = withMarkers [\"param\"] $ do\n  describe \"param\" paramSpec\n\n\ndata Record = Record\n  { age :: Int\n  , msg :: Text\n  }\n  deriving (Generic, ToJSON, FromJSON, ToParam, FromParam, Eq)\n\n\ndata Tag = A | B\n  deriving (Generic, ToParam, FromParam, Eq, Show)\n\n\ndata Tag2 = C | Tag Text\n  deriving (Generic, ToParam, FromParam, Eq, Show)\ninstance ToJSON Tag2 where\n  toJSON = genericToJSON jsonOptions\n\n\nparamSpec :: Spec\nparamSpec = do\n  describe \"ToParam\" $ do\n    it \"should encode basics\" $ do\n      toParam @Text \"hello\" `shouldBe` \"hello\"\n      toParam @Int 23 `shouldBe` ParamValue \"23\"\n\n    it \"should encode Maybe\" $ do\n      toParam @(Maybe Int) Nothing `shouldBe` ParamValue \"~\"\n      toParam @(Maybe Int) (Just 23) `shouldBe` ParamValue \"23\"\n\n    it \"encodes simple constructors\" $ do\n      toParam A `shouldBe` ParamValue \"A\"\n      toParam B `shouldBe` ParamValue \"B\"\n\n    it \"encodes complex constructors as json\" $ do\n      toParam C `shouldBe` jsonParam C\n      toParam (Tag \"hello world\") `shouldBe` jsonParam (Tag \"hello world\")\n\n    -- it \"should encode lists with spaces = plusses\" $ do\n    --   toParam @[Int] [1, 2, 3] `shouldBe` ParamValue (\"1+2+3\")\n    --   toParam @[Text] [\"one\", \"two\"] `shouldBe` ParamValue (\"one+two\")\n    --   toParam @[Text] [\"hello world\", \"friend\"] `shouldBe` ParamValue (\"hello%20world+friend\")\n\n    it \"should not escape text\" $ do\n      toParam @Text \"hello world\" `shouldBe` ParamValue \"hello world\"\n      toParam @Text \"hello_world\" `shouldBe` ParamValue \"hello_world\"\n      toParam @Text \"hello+world\" `shouldBe` ParamValue \"hello+world\"\n\n    it \"encodes json\" $ do\n      let r = Record 10 \"hello world\"\n      toParam r `shouldBe` jsonParam (toJSON r)\n\n      let r2 = Record 10 \"hello_world\"\n      toParam r2 `shouldBe` jsonParam (toJSON r2)\n      toParam r2 `shouldBe` ParamValue (cs (encode r2))\n\n  describe \"FromParam\" $ do\n    it \"should parse basics\" $ do\n      parseParam @Text \"hello\" `shouldBe` Right \"hello\"\n      parseParam @Int \"3\" `shouldBe` Right 3\n\n    it \"decodes json\" $ do\n      let r2 = Record 10 \"hello_world\"\n      parseParam (jsonParam r2) `shouldBe` Right r2\n      parseParam (ParamValue $ cs $ encode r2) `shouldBe` Right r2\n\n    it \"can decode numbers as text\" $ do\n      parseParam @Text \"3\" `shouldBe` Right \"3\"\n\n    it \"should not escape text\" $ do\n      parseParam @Text \"hello world\" `shouldBe` Right \"hello world\"\n      parseParam @Text \"hello_world\" `shouldBe` Right \"hello_world\"\n      parseParam @Text \"hello+world\" `shouldBe` Right \"hello+world\"\n\n  describe \"RoundTrip\" $ do\n    it \"round trips constructors\" $ do\n      parseParam (toParam A) `shouldBe` Right A\n      parseParam (toParam B) `shouldBe` Right B\n      parseParam (toParam C) `shouldBe` Right C\n      let t = Tag \"woo hoo\"\n      parseParam (toParam t) `shouldBe` Right t\n"
  },
  {
    "path": "test/Test/QuerySpec.hs",
    "content": "{-# LANGUAGE DerivingVia #-}\n{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE RecordWildCards #-}\n\nmodule Test.QuerySpec where\n\nimport Data.Function ((&))\nimport Data.Text (Text)\nimport Skeletest\nimport Skeletest.Predicate qualified as P\nimport Web.Hyperbole hiding (Number)\nimport Web.Hyperbole.Data.QueryData as QueryData\n\n\nspec :: Spec\nspec = withMarkers [\"param\"] $ do\n  describe \"render\" renderSpec\n  describe \"class\" classSpec\n  describe \"multi\" multiSpec\n\n\ndata Woot = Woot Text\n  deriving (Generic, Show)\n\n\ndata Record = Record\n  { age :: Int\n  , msg :: Text\n  }\n  deriving (Generic, ToJSON, FromJSON, ToParam, FromParam, Eq, FromQuery, ToQuery)\n\n\nclassSpec :: Spec\nclassSpec = do\n  describe \"FromQuery\" $ do\n    it \"decodes record\" $ do\n      let qd = QueryData.parse \"age=20&msg=hello_world\"\n      parseQuery @Record qd `shouldSatisfy` P.right P.anything\n\n    it \"decodes numbers as text if needed\" $ do\n      let qd = QueryData.parse \"age=20&msg=30\"\n      parseQuery @Record qd `shouldBe` Right (Record 20 \"30\")\n\n  describe \"ToQuery\" $ do\n    it \"encodes record\" $ do\n      let r = Record 20 \"hello world\"\n      QueryData.render (toQuery r) `shouldBe` \"age=20&msg=hello_world\"\n\n  describe \"roundtrip\" $ do\n    it \"round trips\" $ do\n      let r = Record 20 \"hello world\"\n      parseQuery (toQuery r) `shouldBe` Right r\n\n\nrenderSpec :: Spec\nrenderSpec = do\n  it \"should parse multiple items\" $ do\n    let qd = parse \"msg=hello&age=1\"\n    require @Text \"msg\" qd `shouldBe` Right \"hello\"\n    require @Int \"age\" qd `shouldBe` Right 1\n\n  it \"should render as a querystring\" $ do\n    let q =\n          mempty\n            & QueryData.insert @Text \"msg\" \"value\"\n            & QueryData.insert @Int \"age\" 1\n    QueryData.render q `shouldBe` \"age=1&msg=value\"\n\n  it \"should escape special characters in strings\" $ do\n    let q = mempty & QueryData.insert @Text \"msg\" \"bob&henry=fast\"\n    QueryData.render q `shouldBe` \"msg=bob%26henry%3Dfast\"\n\n  -- it \"handles underscores\" $ do\n  --   QueryData.render [(Param \"msg\", ParamValue \"hello_world\" $ String \"hello_world\")] `shouldBe` \"msg=hello%5C_world\"\n  --   QueryData.render [(Param \"msg\", ParamValue \"hello world\" $ String \"hello world\")] `shouldBe` \"msg=hello_world\"\n\n  it \"should roundtrip special characters\" $ do\n    let msg = \"bob&henry=fast\"\n    let q = mempty & QueryData.insert @Text \"msg\" msg\n    let out = QueryData.render q\n    let q' = QueryData.parse out\n    QueryData.lookup \"msg\" q' `shouldBe` Just msg\n\n\n-- it \"should preserve plusses\" $ do\n--   let QueryData q = QueryData $ M.fromList [(\"items\", \"one+two\")]\n--   print $ HTTP.toQuery $ M.toList q\n--   QueryData.render (QueryData q) `shouldBe` \"items=one+two\"\n\ndata Filters = Filters\n  { term :: Text\n  , isActive :: Bool\n  , another :: Maybe Text\n  }\n  deriving (Eq, Show)\n\n\ninstance ToQuery Filters where\n  toQuery f =\n    mempty\n      & QueryData.insert \"term\" f.term\n      & QueryData.insert \"isActive\" f.isActive\n      & QueryData.insert \"another\" f.another\n\n\ninstance FromQuery Filters where\n  parseQuery q = do\n    term <- QueryData.require \"term\" q\n    isActive <- QueryData.require \"isActive\" q\n    another <- QueryData.require \"another\" q\n    pure Filters{..}\n\n\ndata Filters' = Filters'\n  { term :: Text\n  , isActive :: Bool\n  }\n  deriving (Generic, Eq, ToJSON, FromJSON, FromParam, ToParam)\ninstance Default Filters' where\n  def = Filters' \"\" False\n\n\ndata Nested = Nested\n  { filters :: Filters'\n  }\n  deriving (Generic, ToQuery, FromQuery)\n\n\n-- instance ToQuery Nested where\n--   toQuery n =\n--     mempty & QueryData.insert \"filters\" (JSON n.filters)\n--\n--\n-- instance FromQuery Nested where\n--   parseQuery q =\n--     mempty & QueryData.insert \"filters\" (JSON n.filters)\n\nmultiSpec :: Spec\nmultiSpec = do\n  describe \"Roundtrip\" $ do\n    it \"should parse from querydata\" $ do\n      let f = Filters \"hello world\" False Nothing\n      let out = QueryData.render (toQuery f)\n      let q = QueryData.parse out\n      parseQuery q `shouldBe` Right f\n\n    it \"should work with Just\" $ do\n      let f = Filters \"hello_world\" False (Just \"hello\")\n      let out = QueryData.render (toQuery f)\n      let q = QueryData.parse out\n      parseQuery q `shouldBe` Right f\n"
  },
  {
    "path": "test/Test/RouteSpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.RouteSpec where\n\nimport Data.Text (Text)\nimport GHC.Generics\nimport Skeletest\nimport Web.Hyperbole.Route\n\n\ndata Routes\n  = MainPage\n  | Hello Hello\n  | Goodbye\n  deriving (Show, Generic, Eq)\ninstance Route Routes where\n  baseRoute = Just MainPage\n\n\ndata Hello\n  = MainHello\n  | World\n  | Message String\n  deriving (Show, Generic, Eq)\ninstance Route Hello where\n  baseRoute = Just MainHello\n\n\ndata NoMain = NoMain Nested\n  deriving (Show, Generic, Eq, Route)\n\n\ndata Nested\n  = Something\n  | Nested Text\n  deriving (Show, Generic, Eq, Route)\n\n\nspec :: Spec\nspec = do\n  describe \"Route\" $ do\n    describe \"routePath\" $ do\n      it \"basic\" $\n        routePath Goodbye `shouldBe` [\"goodbye\"]\n\n      it \"default\" $\n        routePath MainPage `shouldBe` []\n\n      it \"dynamic\" $\n        routePath (Hello (Message \"woot\")) `shouldBe` [\"hello\", \"message\", \"woot\"]\n\n      it \"compound\" $\n        routePath (Hello World) `shouldBe` [\"hello\", \"world\"]\n\n      it \"compound default\" $\n        routePath (Hello MainHello) `shouldBe` [\"hello\"]\n\n      it \"constructors with parameters should use full url\" $\n        routePath (NoMain (Nested \"woot\")) `shouldBe` [\"nomain\", \"nested\", \"woot\"]\n\n      it \"no main should use full url\" $\n        routePath (NoMain Something) `shouldBe` [\"nomain\", \"something\"]\n\n    describe \"matchRoute\" $ do\n      it \"basic\" $ matchRoute [\"goodbye\"] `shouldBe` Just Goodbye\n      -- it \"default empty string\" $ matchRoute [\"\"] `shouldBe` Just MainPage\n      it \"default empty\" $ matchRoute [] `shouldBe` Just MainPage\n      it \"compound\" $ matchRoute [\"hello\", \"world\"] `shouldBe` Just (Hello World)\n      it \"compound default\" $ matchRoute [\"hello\"] `shouldBe` Just (Hello MainHello)\n      it \"compound dynamic\" $ matchRoute [\"hello\", \"message\", \"whatever\"] `shouldBe` Just (Hello (Message \"whatever\"))\n      it \"no base compound\" $ matchRoute [\"nomain\", \"nested\", \"hello\"] `shouldBe` Just (NoMain (Nested \"hello\"))\n\n    describe \"baseRoute\" $ do\n      it \"default\" $ baseRoute `shouldBe` Just MainPage\n      it \"compound\" $ (baseRoute @Hello) `shouldBe` Just MainHello\n      it \"none\" $ (baseRoute @Nested) `shouldBe` Nothing\n"
  },
  {
    "path": "test/Test/SessionSpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.SessionSpec where\n\nimport Data.String.Conversions (cs)\nimport Data.Text (Text)\nimport Network.HTTP.Types (urlEncode)\nimport Skeletest\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.Cookie as Cookie\nimport Web.Hyperbole.Data.Encoded qualified as Encoded\nimport Web.Hyperbole.Data.URI\nimport Web.Hyperbole.Effect.Session (sessionCookie)\n\n\n-- import Skeletest.Predicate qualified as P\n\ndata Woot = Woot Text\n  deriving (Generic, Show, ToEncoded, FromEncoded)\ninstance Session Woot where\n  cookiePath = Just $ Path [\"somepage\"]\n\n\ndata InsecureSession = InsecureSession Text\n  deriving (Generic, Show, ToEncoded, FromEncoded)\ninstance Session InsecureSession where\n  cookieSecure = False\n\n\nspec :: Spec\nspec = do\n  describe \"Session\" $ do\n    it \"should encode cookie\" $ do\n      let woot = Woot \"hello\"\n      toCookie woot `shouldBe` CookieValue (cs $ Encoded.encode woot)\n\n  describe \"sessionCookie\" $ do\n    it \"should create cookie\" $ do\n      let woot = Woot \"hello\"\n      sessionCookie woot `shouldBe` Cookie (sessionKey @Woot) (cookiePath @Woot) (Just (toCookie woot)) (cookieSecure @Woot)\n\n  describe \"render\" $ do\n    it \"should parse cookies\" $ do\n      Cookie.parse [(\"Woot\", \"Woot\")] `shouldBe` Right (Cookie.fromList [Cookie \"Woot\" Nothing (Just (CookieValue \"Woot\")) True])\n\n    it \"should render cookie with root path\" $ do\n      let cookie = Cookie \"Woot\" Nothing (Just (CookieValue \"Woot\")) True\n      Cookie.render [] cookie `shouldBe` \"Woot=Woot; SameSite=None; secure; path=/\"\n\n    it \"should render non-secure cookie\" $ do\n      let cookie = Cookie \"Woot\" Nothing (Just (CookieValue \"Woot\")) False\n      Cookie.render [] cookie `shouldBe` \"Woot=Woot; SameSite=Lax; path=/\"\n\n    it \"should render complex cookie with included path\" $ do\n      let woot = Woot \"hello world\"\n      let cookie = sessionCookie woot\n      Cookie.render [] cookie `shouldBe` \"Woot=\" <> urlEncode True (cs $ Encoded.encode woot) <> \"; SameSite=None; secure; path=/somepage\"\n\n  describe \"Session class\" $ do\n    it \"should encode class\" $ do\n      let prefs = Preferences \"hello\" Warning\n      let cooks = Cookie.insert (sessionCookie prefs) mempty\n      Cookie.lookup (sessionKey @Preferences) cooks `shouldBe` Just (CookieValue $ cs $ Encoded.encode prefs)\n\n    it \"should decode class\" $ do\n      let prefs = Preferences \"hello\" Warning\n      let cooks = Cookie.insert (sessionCookie prefs) mempty\n      Just val <- pure $ Cookie.lookup (sessionKey @Preferences) cooks\n      parseCookie val `shouldBe` Right prefs\n\n    it \"should create non-secure cookie when cookieSecure is False\" $ do\n      let insecure = InsecureSession \"test\"\n      let cookie = sessionCookie insecure\n      cookie.secure `shouldBe` False\n\n\ndata Preferences = Preferences\n  { message :: Text\n  , color :: AppColor\n  }\n  deriving (Generic, Eq, Show, ToEncoded, FromEncoded, Session)\ninstance Default Preferences where\n  def = Preferences \"_\" White\n\n\ndata AppColor\n  = White\n  | Light\n  | GrayLight\n  | GrayDark\n  | Dark\n  | DarkHighlight\n  | Success\n  | Danger\n  | Warning\n  | Primary\n  | PrimaryLight\n  | Secondary\n  | SecondaryLight\n  deriving (Show, Eq, Generic, ToParam, FromParam)\n"
  },
  {
    "path": "test/Test/URISpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n{-# LANGUAGE QuasiQuotes #-}\n\nmodule Test.URISpec where\n\nimport Skeletest\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.URI\n\n\nspec :: Spec\nspec = do\n  describe \"URI\" $ do\n    it \"should preserve slashes\" $ do\n      let u = [uri|http://example.com|] ./. \"hello\"\n      u.uriPath `shouldBe` \"/hello\"\n\n    it \"should render with path slashes\" $ do\n      let u = [uri|http://example.com/test|]\n      uriToText (u ./. [\"wahoo\"]) `shouldBe` \"http://example.com/test/wahoo\"\n      uriToText (u ./. [\"/wahoo\"]) `shouldBe` \"http://example.com/test/wahoo\"\n      uriToText (u ./. []) `shouldBe` \"http://example.com/test\"\n      uriToText (u ./. \"/\") `shouldBe` \"http://example.com/test\"\n\n  describe \"Path\" $ do\n    it \"handles edge cases\" $ do\n      path \"\" `shouldBe` []\n      path \"/\" `shouldBe` []\n\n    it \"normal paths\" $ do\n      path \"woot\" `shouldBe` [\"woot\"]\n      path \"woot/hello\" `shouldBe` [\"woot\", \"hello\"]\n      path \"/woot/hello\" `shouldBe` [\"woot\", \"hello\"]\n      path \"/woot/hello/\" `shouldBe` [\"woot\", \"hello\"]\n"
  },
  {
    "path": "test/Test/ViewActionSpec.hs",
    "content": "module Test.ViewActionSpec where\n\nimport Data.Text (Text)\nimport GHC.Generics\nimport Skeletest\nimport Skeletest.Predicate qualified as P\nimport Web.Hyperbole (FromJSON, ToJSON)\nimport Web.Hyperbole.Data.Encoded\nimport Web.Hyperbole.Data.Param\nimport Web.Hyperbole.View\nimport Web.Hyperbole.HyperView.Event (toActionInput)\n\n\ndata Simple = Simple\n  deriving (Generic, Eq, Show, Read, ViewAction, ToJSON, FromJSON, ToParam, FromParam)\n\n\ndata Product = Product String Int\n  deriving (Generic, Show, Eq, ViewAction, Read, ToJSON, FromJSON, ToEncoded, FromEncoded, ToParam, FromParam)\n\n\ndata Product' = Product' HasText Int\n  deriving (Generic, Show, Eq, ViewAction, Read, ToJSON, FromJSON, ToEncoded, FromEncoded)\n\n\ndata Sum\n  = SumA\n  | SumB Int\n  | SubC Text\n  | SubD (Maybe Text)\n  | SubE Term\n  | SubF Simple\n  deriving (Generic, Show, Read, Eq, ViewAction)\n\n\ndata Compound = Compound Product\n  deriving (Generic, Show, Eq, Read, ToJSON, FromEncoded, ToEncoded, FromJSON, ViewAction)\n\n\ndata HasText = HasText Text\n  deriving (Generic, Show, Eq, Read, ViewAction, ToJSON, FromJSON, FromEncoded, ToEncoded, ToParam, FromParam)\n\n\nnewtype Term = Term Text\n  deriving newtype (Eq, Show, ToJSON, FromJSON, Read, ToParam, FromParam)\n\n\nspec :: Spec\nspec = withMarkers [\"encoded\"] $ do\n  describe \"ViewAction\" $ do\n    describe \"toAction\" $ do\n      it \"simple\" $ toAction Simple `shouldBe` Encoded \"Simple\" []\n      it \"has text\" $ toAction (HasText \"hello world\") `shouldBe` Encoded \"HasText\" [\"hello world\"]\n      it \"product\" $ toAction (Product \"hello world\" 123) `shouldBe` Encoded \"Product\" [\"hello world\", toParam @Int 123]\n      it \"sum\" $ toAction (SumB 123) `shouldBe` Encoded \"SumB\" [toParam @Int 123]\n      it \"compound\" $ do\n        let p = Product \"hello world\" 123\n        toAction (Compound p) `shouldBe` Encoded \"Compound\" [toParam p]\n\n    describe \"toActionInput\" $ do\n      it \"Constructor Text\" $ do\n        toActionInput SubC `shouldBe` Encoded \"SubC\" []\n\n      it \"Constructor (Maybe Text)\" $ do\n        toActionInput (SubD . Just) `shouldBe` Encoded \"SubD\" []\n\n      it \"Constructor newtype Term\" $ do\n        toActionInput (SubE . Term) `shouldBe` Encoded \"SubE\" []\n\n      it \"renders data constructors\" $ do\n        toActionInput SubF `shouldBe` Encoded \"SubF\" []\n\n    describe \"parseAction\" $ do\n      it \"simple\" $ parseAction (Encoded \"Simple\" []) `shouldBe` pure Simple\n\n      it \"parse product\" $ do\n        parseAction @Product (Encoded \"Product\" [\"woot\", toParam @Int 1234]) `shouldSatisfy` P.right P.anything\n\n      it \"parse product with spaces\" $ do\n        parseAction @Product (Encoded \"Product\" [\"hello world\", toParam @Int 1234]) `shouldSatisfy` P.right P.anything\n\n    describe \"roundTrip\" $ do\n      it \"simple\" $ do\n        parseAction (toAction Simple) `shouldBe` pure Simple\n      it \"has text multiple words\" $ do\n        let a = HasText \"hello world\"\n        parseAction (toAction a) `shouldBe` pure a\n      it \"product\" $ do\n        let a = Product \"hello world\" 123\n        parseAction @Product (toAction a) `shouldBe` pure a\n      it \"product'\" $ do\n        let a = Product' (HasText \"hello world\") 123\n        parseAction (toAction a) `shouldBe` pure a\n      it \"compound\" $ do\n        let a = Compound (Product \"hello world\" 123)\n        parseAction (toAction a) `shouldBe` pure a\n      it \"sum\" $ do\n        let a = SumB 123\n        parseAction (toAction a) `shouldBe` pure a\n"
  },
  {
    "path": "test/Test/ViewIdSpec.hs",
    "content": "{-# LANGUAGE OverloadedLists #-}\n\nmodule Test.ViewIdSpec where\n\nimport Data.Text (Text)\nimport Data.Text qualified as T\nimport GHC.Generics\nimport Skeletest\nimport Web.Hyperbole\nimport Web.Hyperbole.Data.Encoded\n\n\ndata Thing = Thing\n  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToEncoded, FromEncoded, ViewId, ToParam, FromParam)\n\n\ndata Custom = Custom\n  deriving (Show, Eq)\n\n\ndata HasString = HasString String\n  deriving (Generic, Show, Eq, Read, ViewId)\n\n\ndata Compound\n  = One\n  | Two Thing\n  | WithId (Id Thing)\n  | Compound Text Compound\n  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToEncoded, FromEncoded, ViewId, ToParam, FromParam)\n\n\ndata Product4 = Product4 Text Text Text Text\n  deriving (Generic, Show, Eq, Read, ViewId)\n\n\n-- Regression test for https://github.com/seanhess/hyperbole/issues/187\ndata MessageView = MessageView [Text]\n  deriving (Generic, Show, Eq, ViewId)\n\n\nnewtype Id a = Id {fromId :: Text}\n  deriving newtype (Eq, ToJSON, FromJSON, Ord, Show, ToParam, FromParam)\n  deriving (Generic)\n\n\ninstance ViewId Custom where\n  toViewId Custom = Encoded \"something\" []\n  parseViewId (Encoded \"something\" []) = pure Custom\n  parseViewId _ = Left \"NOPE\"\n\n\nspec :: Spec\nspec = withMarkers [\"encoded\"] $ do\n  describe \"ViewId Encoded\" $ do\n    describe \"toViewId\" $ do\n      it \"basic\" $ encodeViewId Thing `shouldBe` \"Thing\"\n      it \"custom\" $ encodeViewId Custom `shouldBe` \"something\"\n\n    describe \"parseViewId\" $ do\n      it \"basic lowercase\" $ decodeViewId @Thing \"thing\" `shouldBe` Nothing\n      it \"basic\" $ decodeViewId @Thing \"Thing\" `shouldBe` pure Thing\n      it \"custom\" $ decodeViewId @Custom \"something\" `shouldBe` pure Custom\n      it \"custom other\" $ decodeViewId @Thing \"custom\" `shouldBe` Nothing\n\n    describe \"has-string\" $ do\n      it \"should not contain single quotes\" $ do\n        encodeViewId (HasString \"woot\") `shouldBe` \"HasString woot\"\n        containsSingleQuotes (encodeViewId (HasString \"woot\")) `shouldBe` False\n\n      it \"should roundtrip\" $ do\n        let inp = HasString \"woot\"\n        decodeViewId (encodeViewId inp) `shouldBe` pure inp\n\n    describe \"compound\" $ do\n      it \"double roundtrip\" $ decodeViewId (encodeViewId (Two Thing)) `shouldBe` pure (Two Thing)\n\n    describe \"nested\" $ do\n      let nest = Compound \"one\" $ Compound \"two\" (Two Thing)\n      it \"should roundtrip\" $ decodeViewId (encodeViewId nest) `shouldBe` pure nest\n\n    describe \"big product\" $ do\n      let p = Product4 \"one\" \"two\" \"three\" \"four\"\n      it \"should roundtrip\" $ do\n        let vid = encodeViewId p\n        decodeViewId vid `shouldBe` pure p\n\n    -- Regression tests for https://github.com/seanhess/hyperbole/issues/187\n    -- When a ViewId contains a list of Text with newline characters, the\n    -- encoded/decoded form must round-trip correctly.\n    describe \"list with newline (issue #187)\" $ do\n      it \"roundtrips MessageView with single newline\" $ do\n        let v = MessageView [\"\\n\"]\n        decodeViewId (encodeViewId v) `shouldBe` pure v\n\n      it \"roundtrips MessageView with newlines in multiple elements\" $ do\n        let v = MessageView [\"\\n\", \"hello\\nworld\", \"plain\"]\n        decodeViewId (encodeViewId v) `shouldBe` pure v\n\n\n-- describe \"Param Attributes\" $ do\n--   it \"should serialize basic id\" $ do\n--     let atts = mempty :: Attributes id\n--     (setId \"woot\" atts).other `shouldBe` [(\"id\", \"woot\")]\n--\n--   it \"should serialize compound id\" $ do\n--     let atts = mempty :: Attributes id\n--     (setId (toViewId $ Two Thing) atts).other `shouldBe` [(\"id\", toViewId $ Two Thing)]\n--\n--   it \"should serialize stringy id\" $ do\n--     let atts = mempty :: Attributes id\n--     (setId (toViewId $ HasString \"woot\") atts).other `shouldBe` [(\"id\", pack $ show $ HasString \"woot\")]\n--\n--   it \"should serialize with Id\" $ do\n--     let atts = mempty :: Attributes id\n--     (setId (toViewId $ WithId (Id \"woot\")) atts).other `shouldBe` [(\"id\", \"WithId \\\"woot\\\"\")]\n\ncontainsSingleQuotes :: Text -> Bool\ncontainsSingleQuotes = T.elem '\\''\n\n-- setId :: Text -> Mod id\n-- setId = att \"id\"\n"
  },
  {
    "path": "test/Test/ViewSpec.hs",
    "content": "module Test.ViewSpec where\n\nimport Skeletest\nimport Web.Hyperbole\n\n\nspec :: Spec\nspec = do\n  describe \"View\" $ do\n    describe \"monad\" $ do\n      it \"renders all nodes with do\" $ do\n        let v = do\n              el \"one\"\n              el \"two\"\n        renderText v `shouldBe` \"<div>one</div>\\n<div>two</div>\"\n\n      it \"renders all nodes with >>\" $ do\n        let v = el \"one\" >> el \"two\"\n        renderText v `shouldBe` \"<div>one</div>\\n<div>two</div>\"\n\n      it \"renders all nodes with >>=\" $ do\n        let v = el \"one\" >>= \\_ -> el \"two\"\n        renderText v `shouldBe` \"<div>one</div>\\n<div>two</div>\"\n"
  }
]