2cf10f8..master · obelisk

.github/pull_request_template.md+2

since splitsnapshots

unifiedsplit

@@ -3,6 +3,8 @@

3I have:

4

5 - [ ] Based work on latest `develop` branch

6+ - [ ] Followed the [contribution guide](https://github.com/obsidiansystems/obelisk/blob/develop/CONTRIBUTING.md#submitting-changes)

6 - [ ] Looked for lint in my changes with `hlint .` (lint found code you did not write can be left alone)

7 - [ ] Looked for lint in my changes with `hlint .` (lint found code you did not write can be left alone)

7 - [ ] Run the test suite: `$(nix-build -A selftest --no-out-link)`

8 - [ ] Run the test suite: `$(nix-build -A selftest --no-out-link)`

9+ - [ ] [Updated the changelog](https://github.com/obsidiansystems/obelisk/blob/develop/CONTRIBUTING.md#in-the-changelog)

8 - [ ] (Optional) Run CI tests locally: `nix-build release.nix -A build.x86_64-linux --no-out-link` (or `x86_64-darwin` on macOS)

10 - [ ] (Optional) Run CI tests locally: `nix-build release.nix -A build.x86_64-linux --no-out-link` (or `x86_64-darwin` on macOS)

CONTRIBUTING.md+52

@@ -8,6 +8,7 @@ Contributions and issue reports are encouraged and appreciated!

8 - [Guidelines for Pull Requests](#guidelines-for-pull-requests)

9 - [Code Quality](#code-quality)

10 - [Documentation](#documentation)

11+- [Development Environment](#development-environment)

11

12

12## Opening Issues

13## Opening Issues

13

14

@@ -39,6 +40,7 @@ For breaking changes, new features, refactors, or other major changes, the body

39

40

40Wherever possible, pull requests should add a single feature or fix a single bug. Pull requests should not bundle several unrelated changes.

41Wherever possible, pull requests should add a single feature or fix a single bug. Pull requests should not bundle several unrelated changes.

41

42

43+

42### Code Quality

44### Code Quality

43

45

44#### Warnings

46#### Warnings

@@ -77,3 +79,53 @@ Add an entry to the changelog when your PR:

77#### In the [Readme](README.md)

79#### In the [Readme](README.md)

78The readme is the first place a lot of people look for information about the repository. Update any parts of the readme that are affected by your PR.

80The readme is the first place a lot of people look for information about the repository. Update any parts of the readme that are affected by your PR.

79

81

82+

83+## Development Environment

84+

85+There are two ways to get live compiler feedback while developing Obelisk libraries. For libraries that are dependencies of the `skeleton` application, the easiest way to get feedback is to

86+

87+```bash

88+cd skeleton

89+ob run

90+```

91+

92+This `ob run` session only loads modules that are dependencies of the skeleton and `obelisk-run`. For example, `obelisk-asset` and `obelisk-route` are used by the skeleton.

93+

94+For other libraries like `obelisk-command` you can use `ghcid`. To launch `ghcid` for `lib/command` you can run

95+

96+```bash

97+nix-shell -A obeliskEnvs.obelisk-command --run "cd lib/command && ghcid"

98+```

99+

100+### Building `ob` for testing

101+

102+To re-install `ob` from source globally you can do

103+

104+```bash

105+nix-env -f /path/to/obelisk -iA command

106+```

107+

108+You can also open a shell with the local version of `ob` available on your `$PATH`:

109+

110+```bash

111+nix run -f /path/to/obelisk command

112+```

113+

114+### Hacking on Obelisk from within an Obelisk project

115+

116+`ob` will defer to the version found in your project's `.obelisk/impl` directory. To work on that version specifically:

117+

118+```bash

119+ob thunk unpack ./.obelisk/impl

120+cd ./.obelisk/impl

121+# apply your changes

122+```

123+

124+If you want to commit your changes, first push them to your fork of obelisk and then

125+

126+```bash

127+cd /your/project/root

128+ob thunk pack .obelisk/impl

129+git add .obelisk/impl

130+git commit -m "Bump obelisk"

131+```

ChangeLog.md+32−20

@@ -2,38 +2,50 @@

2

3This project's release branch is `master`. This log is written from the perspective of the release branch: when changes hit `master`, they are considered released.

4

5−## Unreleased

5+## v0.9.1.0

6

7−* ([#674](https://github.com/obsidiansystems/obelisk/pull/674)) Introduce a new thunk format to support accessing the thunk's source directly. Previously thunks only supported sources that contained `default.nix`. With the latest format both packed and unpacked thunks have a similar directory structure:

7+* [#801](https://github.com/obsidiansystems/obelisk/pull/801): Remove errors and warning for local packages without a library component

8+* [#812](https://github.com/obsidiansystems/obelisk/pull/812): Add support for `NoImplicitPrelude` and other extensions disabled via `No`

9+* Pinned version bumps:

10+ * reflex-platform [0.7.0.0](https://github.com/reflex-frp/reflex-platform/releases/tag/v0.7.0.0)

11+ * hnix 0.8.0

12+* [#787](https://github.com/obsidiansystems/obelisk/pull/787): Set `immutable` cache control directive when serving content-addressed static assets

13+* Use iOS SDK 13.2

8

14

9− Packed thunks look like

10

15

11− my-thunk/

16+## v0.9.0.1

12− ├── default.nix

13− ├── thunk.nix

14− └── github.json

15

17

16− and unpacked thunks look like

18+* ([#810](https://github.com/obsidiansystems/obelisk/pull/810)) Fix loading of `all.js` in fully compiled web apps.

17

19

18− my-thunk/

20+## v0.9.0.0

19− ├── default.nix

20− ├── thunk.nix

21− └── local

22− └── ... # checkout of your dependency

23

21

24− Instead of unpacked thunks *replacing* your thunk files, the source is placed in `local`.

22+* **(Breaking change)** Backport nixpkgs upgrades to ACME/Let's Encrypt handling so that HTTPS deployments continue to work flawlessly. If your deployment is having trouble renewing [Let's Encrypt](https://letsencrypt.org/) certificates, upgrade to this version.

23+ * **IMPORTANT:** In order to use [Let's Encrypt](https://letsencrypt.org/) you must now accept their [terms of service](https://letsencrypt.org/repository/). To do that, add `terms.security.acme.acceptTerms = true;` to the `import ./.obelisk/impl {` section in your `default.nix`. The new skeleton application may serve as an [example](https://github.com/obsidiansystems/obelisk/blob/4759342ab3570888c027d4c58cb5694cb832d624/skeleton/default.nix#L13).

24+* Update reflex-platform dependency to v0.6.0.0

25+* ([#715](https://github.com/obsidiansystems/obelisk/pull/715)) In `Obelisk.Route` deprecate `isoEncoder` and `prismEncoder` in favor of more precisely named `viewEncoder` and `reviewEncoder` (respectively) and improve documentation regarding contravariance of `reviewEncoder`.

26+* ([#739](https://github.com/obsidiansystems/obelisk/pull/739)) Improve `ob shell` by allowing commands to be passed verbatim after a `--` argument. For example, `ob shell 'run command'` can now be written `ob shell -- run command`.

27+* ([#735](https://github.com/obsidiansystems/obelisk/pull/735)) Fix regression causing custom `Prelude`s to break `ob run`/`ob watch`/`ob repl`.

28+* ([#737](https://github.com/obsidiansystems/obelisk/pull/737)) Fix bug causing custom `Prelude`s to break `ob profile`.

29+* ([#752](https://github.com/obsidiansystems/obelisk/pull/752)) Fix the `ob` command-line tool to return non-zero exit code when underlying processes fail.

30+* ([#742](https://github.com/obsidiansystems/obelisk/pull/742), [#57](https://github.com/obsidiansystems/obelisk/pull/57), [#406](https://github.com/obsidiansystems/obelisk/pull/406)) Enable `-dedupe` and `-DGHCJS_BROWSER` in GHCJS builds to make JavaScript output considerably smaller leading to faster load/parse times and faster build times.

31+ * **Migration:** New Obelisk projects will automatically benefit from this change, but existing projects need to apply a change similar to [this one](https://github.com/obsidiansystems/obelisk/blob/371cb3302085601c5ec73e9574d51c8b95e3e493/skeleton/frontend/frontend.cabal#L32-L34).

32+* ([#742](https://github.com/obsidiansystems/obelisk/pull/742)) Update `reflex-platform` which includes:

33+ * A new version of GHCJS where `-dedupe` is fixed.

25

34

26− This format provides the new `thunk.nix` interface regardless of whether the thunk is packed or unpacked. With this you can always access the raw source of your thunk from nix with `import my-thunk/thunk.nix`. `thunk.nix` always uses your local copy if it's available or fetches the source described in `github.json`/`git.json` if it's not.

35+## v0.8.0.0

27

36

28− To convert a `git` checkout into a thunk you can use the new `ob thunk init` command. `ob thunk pack` will automatically perform `ob thunk init` on raw `git` checkouts.

37+* ([#674](https://github.com/obsidiansystems/obelisk/pull/674), [#711](https://github.com/obsidiansystems/obelisk/pull/711)) Introduce a new thunk format to support accessing the thunk's source directly when packed. When packed, thunks have an additional file called `thunk.nix` and `default.nix` is now a thin wrapper around that.

29−

30− Note that this format is backwards compatible since `import ./my-thunk` works the same way both before and after this change.

31* ([#665](https://github.com/obsidiansystems/obelisk/pull/665)) Add `--interpret` and `--no-interpret` options to `ob run`/`ob watch`/`ob repl`/`ob shell`. These options allow you to pick which paths will be pre-compiled by `nix` when entering the shell/session and which won't. For example `ob run --no-interpret dep` will ensure that any dependencies found in `./dep` will be built by `nix` before loading the rest of the project into the `ghci` session. The same configuration for `ob shell` will ensure that those packages are built and available in the `ghc` package database inside the shell.

38* ([#665](https://github.com/obsidiansystems/obelisk/pull/665)) Add `--interpret` and `--no-interpret` options to `ob run`/`ob watch`/`ob repl`/`ob shell`. These options allow you to pick which paths will be pre-compiled by `nix` when entering the shell/session and which won't. For example `ob run --no-interpret dep` will ensure that any dependencies found in `./dep` will be built by `nix` before loading the rest of the project into the `ghci` session. The same configuration for `ob shell` will ensure that those packages are built and available in the `ghc` package database inside the shell.

32

39

33 **NOTE:** `ob shell`'s default behavior is now different. By default it now behaves like `ob run`/`ob watch`/`ob repl` in that it does *not* pre-build any packages whose `.cabal` or `package.yaml` files are found in the project. To regain the previous behavior, use `ob shell --no-interpret . --interpret backend --interpret common --interpret frontend` from the project root.

40 **NOTE:** `ob shell`'s default behavior is now different. By default it now behaves like `ob run`/`ob watch`/`ob repl` in that it does *not* pre-build any packages whose `.cabal` or `package.yaml` files are found in the project. To regain the previous behavior, use `ob shell --no-interpret . --interpret backend --interpret common --interpret frontend` from the project root.

34* ([#695](https://github.com/obsidiansystems/obelisk/pull/695)) `ob deploy init` now requires that your obelisk project be a clean `git` checkout with pushed changes. It has always required that your obelisk project be a `git` repository, but it did not require that your local changes be committed and pushed. This new requirement is added to ensure users don't accidentally create a deployment pointing to an old version of the project.

41* ([#695](https://github.com/obsidiansystems/obelisk/pull/695)) `ob deploy init` now requires that your obelisk project be a clean `git` checkout with pushed changes. It has always required that your obelisk project be a `git` repository, but it did not require that your local changes be committed and pushed. This new requirement is added to ensure users don't accidentally create a deployment pointing to an old version of the project.

42+* ([#705](https://github.com/obsidiansystems/obelisk/pull/705)) Add `Obelisk.Route.packTextEncoder` and generalize `Obelisk.Route.unpackTextEncoder` over any `Data.Text.Lens.IsText`.

43+* ([#712](https://github.com/obsidiansystems/obelisk/pull/712)) Update [`reflex-platform`](https://github.com/reflex-frp/reflex-platform) to version 0.5.3.0.

44+* ([#700](https://github.com/obsidiansystems/obelisk/pull/700)) Ensure `ob init` uses the thunk format of the target obelisk rather than the one currently running the init command. If a user had installed a version of obelisk with a new thunk format, a newly initialized skeleton of an older version would not be able to unpack its own `.obelisk/impl`.

35* ([#693](https://github.com/obsidiansystems/obelisk/pull/693)) Fix a bug where some packages in `.attr-cache` directories would be incorrectly picked up and used instead of the correct ones when using `ob run`/`ob watch`/`ob repl`.

45* ([#693](https://github.com/obsidiansystems/obelisk/pull/693)) Fix a bug where some packages in `.attr-cache` directories would be incorrectly picked up and used instead of the correct ones when using `ob run`/`ob watch`/`ob repl`.

36−* ([#700](https://github.com/obsidiansystems/obelisk/pull/700)) Ensure `ob init` uses the thunk format of the target obelisk rather than the one currently running the init command. If a user had installed a version of obelisk with a new thunk format, a newly initialized skeleton of an older version would not be able to unpack it's own `.obelisk/impl`.

46+* ([#709](https://github.com/obsidiansystems/obelisk/pull/709)) Fix a bug in obelisk's preprocessor causing it to incorrectly skip files in some circumstances.

47+* ([#663](https://github.com/obsidiansystems/obelisk/pull/663)) Add **experimental** support for [`ghcide`](https://github.com/digital-asset/ghcide). See the README for more information.

48+* ([#714](https://github.com/obsidiansystems/obelisk/pull/714)) Miscellaneous improvements to CLI help and logging.

37

49

38## v0.7.0.1

50## v0.7.0.1

39

51

@@ -80,7 +92,7 @@ This project's release branch is `master`. This log is written from the perspect

80* Improve error messaging when a dependency doesn't have the expected `.cabal` or `package.yaml` file. ([#597](https://github.com/obsidiansystems/obelisk/pull/597))

92* Improve error messaging when a dependency doesn't have the expected `.cabal` or `package.yaml` file. ([#597](https://github.com/obsidiansystems/obelisk/pull/597))

81* Improve the skeleton in small ways. ([#593](https://github.com/obsidiansystems/obelisk/pull/593), [#589](https://github.com/obsidiansystems/obelisk/pull/589))

93* Improve the skeleton in small ways. ([#593](https://github.com/obsidiansystems/obelisk/pull/593), [#589](https://github.com/obsidiansystems/obelisk/pull/589))

82* Fix `ob` commands to again support running from any subdirectory of an obelisk project ([#591](https://github.com/obsidiansystems/obelisk/pull/591))

94* Fix `ob` commands to again support running from any subdirectory of an obelisk project ([#591](https://github.com/obsidiansystems/obelisk/pull/591))

83−* Add `reflex-platform-func` argument to Obelisk's `default.nix`. It defaults to it's prior behavior of using the reflex-platform in in `dep`. ([#612](https://github.com/obsidiansystems/obelisk/pull/612))

95+* Add `reflex-platform-func` argument to Obelisk's `default.nix`. It defaults to its prior behavior of using the reflex-platform in in `dep`. ([#612](https://github.com/obsidiansystems/obelisk/pull/612))

84

96

85## v0.3.0.0 - 2019-12-20

97## v0.3.0.0 - 2019-12-20

86

98

FAQ.md+62−67

@@ -1,14 +1,70 @@

1# Frequently Asked Questions

2

3+1. [How do I declare a new Haskell dependency?](#how-do-i-declare-a-new-haskell-dependency)

4+1. [How do I add or override Haskell dependencies in the package set?](#how-do-i-add-or-override-haskell-dependencies-in-the-package-set)

5+1. [How do I extend my Obelisk application with more local packages?](#how-do-i-extend-my-obelisk-application-with-more-local-packages)

6+1. [How do I use `ob run` over HTTPS?](#how-do-i-use-ob-run-over-https)

3−1. [How do I fix invalid entitlements? ](#how-do-i-fix-invalid-entitlements)

7+1. [How do I fix invalid entitlements?](#how-do-i-fix-invalid-entitlements)

41. [`ob thunk update` or `ob deploy update` fails](#ob-thunk-update-or-ob-deploy-update-fails)

81. [`ob thunk update` or `ob deploy update` fails](#ob-thunk-update-or-ob-deploy-update-fails)

51. [How do I fix `Ambiguous module name` errors?](#how-do-i-fix-ambiguous-module-name-errors)

91. [How do I fix `Ambiguous module name` errors?](#how-do-i-fix-ambiguous-module-name-errors)

6−1. [What does `ob run` actually do?](#what-does-ob-run-actually-do)

10+

11+### How do I declare a new Haskell dependency?

12+

13+Every component of your Obelisk application is a standard [cabal](https://www.haskell.org/cabal/) package. That means declaring new Haskell dependencies simply involves updating the `build-depends` field in the appropriate cabal file (`backend.cabal` for example). By default, Obelisk will use its curated package set to choose which version of each package you get. It's possible that the package you need is not already in the curated set or the curated version isn't the one you want. See [How do I add or override Haskell dependencies in the package set?](#how-do-i-add-or-override-haskell-dependencies-in-the-package-set) for a solution to this.

14+

15+### How do I add or override Haskell dependencies in the package set?

16+

17+To add a Haskell package that doesn't exist in Obelisk's package set or to override the version of a package, use the `overrides` attribute in your project's `default.nix`. For example, to use a specific version of the `aeson` package fetched from GitHub and a specific version of the `waargonaut` package fetched from Hackage, your `default.nix` will look like:

18+

19+```nix

20+# ...

21+project ./. ({ pkgs, ... }: {

22+# ...

23+ overrides = self: super: let

24+ aesonSrc = pkgs.fetchFromGitHub {

25+ owner = "obsidiansystems";

26+ repo = "aeson-gadt-th";

27+ rev = "ed573c2cccf54d72aa6279026752a3fecf9c1383";

28+ sha256 = "08q6rnz7w9pn76jkrafig6f50yd0f77z48rk2z5iyyl2jbhcbhx3";

29+ };

30+ in

31+ {

32+ aeson = self.callCabal2nix "aeson" aesonSrc {};

33+ waargonaut = self.callHackageDirect {

34+ pkg = "waargonaut";

35+ ver = "0.8.0.1";

36+ sha256 = "1zv28np3k3hg378vqm89v802xr0g8cwk7gy3mr77xrzy5jbgpa39";

37+ } {};

38+ };

39+# ...

40+```

41+

42+For further information see [the Haskell section](https://nixos.org/nixpkgs/manual/#users-guide-to-the-haskell-infrastructure) of nixpkgs "Contributors Guide".

43+

44+### How do I extend my Obelisk application with more local packages?

45+

46+If the standard packages (`frontend`, `backend`, and `common`) are not enough, you may add more local packages by defining them with the `packages` attribute in your `default.nix`. The sources of these packages will be automatically loaded by `ob run`/`ob repl`/etc.

47+

48+```nix

49+# ...

50+project ./. ({ pkgs, ... }: {

51+# ...

52+ packages = {

53+ another = ./dep/another;

54+ };

55+# ...

56+```

57+

58+### How do I use `ob run` over HTTPS?

59+

60+To run your app locally over HTTPS, update the protocol in `config/common/route` to `https`, and then use `ob run` as normal.

61+

62+Obelisk generates a self-signed certificate for running HTTPS so the browser will issue a warning about using an invalid certificate. On Chrome, you can go to `chrome://flags/#allow-insecure-localhost` to enable invalid certificates for localhost.

63+

7

64

8### How do I fix invalid entitlements?

65### How do I fix invalid entitlements?

9

66

10−You probably did not set `ios.bundleIdentifier` correctly in `default.nix`.

67+You probably did not set `ios.bundleIdentifier` correctly in `default.nix`. When this happens you'll see an error something like this:

11−When this happens you'll see an error something like this:

12

68

13```

69```

142018-11-25 09:34:22.438 ios-deploy[58106:8521046] [ !! ] Error 0xe8008016: The executable was signed with invalid entitlements. AMDeviceSecureInstallApplication(0, device, url, options, install_callback, 0)

702018-11-25 09:34:22.438 ios-deploy[58106:8521046] [ !! ] Error 0xe8008016: The executable was signed with invalid entitlements. AMDeviceSecureInstallApplication(0, device, url, options, install_callback, 0)

@@ -19,7 +75,7 @@ Fixing the value of `ios.bundleIdentifier` should fix the error.

19### `ob thunk update` or `ob deploy update` fails

75### `ob thunk update` or `ob deploy update` fails

20Whenever an `ob` command fails, try re-running it with `-v`.

76Whenever an `ob` command fails, try re-running it with `-v`.

21

77

22−If you're using a private repo, and you get a failure in nix-prefetch-url, you may need to unpack and repack the thunk. Here's some example output that shows this issue:

78+If you're using a private repo, and you get a failure in `nix-prefetch-url`, you may need to unpack and repack the thunk. Here's some example output that shows this issue:

23

79

24```

80```

25Starting Obelisk </nix/store/j8wls8a89xr6s1a47lg6g83gnbdrfd0l-obelisk-command-0.1/bin/.ob-wrapped> args=["deploy","update","-v"] logging-level=Debug

81Starting Obelisk </nix/store/j8wls8a89xr6s1a47lg6g83gnbdrfd0l-obelisk-command-0.1/bin/.ob-wrapped> args=["deploy","update","-v"] logging-level=Debug

@@ -39,7 +95,7 @@ nix-prefetch-url: Failed to determine sha256 hash of URL https://github.com/obsi

39

95

40And here's how you can fix it:

96And here's how you can fix it:

41

97

42−```

98+```bash

43ob thunk unpack $SOME_THUNK

99ob thunk unpack $SOME_THUNK

44ob thunk pack $SOME_THUNK

100ob thunk pack $SOME_THUNK

45```

101```

@@ -59,64 +115,3 @@ error:

59```

115```

60then specify the package you want in the import, e.g:

116then specify the package you want in the import, e.g:

61`import "cryptonite" Crypto.Hash`

117`import "cryptonite" Crypto.Hash`

62−

63−

64−### What does `ob run` actually do?

65−

66−

67−#### Short version:

68−

69−`ob run` starts a [`ghcid`](https://github.com/ndmitchell/ghcid) process which

70−tries to build your project within a carefully crafted `nix-shell` with all the

71−project's dependencies and,

72−

73−* either displays compilation errors/warnings,

74−* or starts the Obelisk server, which serves:

75− * your backend's route handlers,

76− * the static assets,

77− * the [JSaddle](https://github.com/ghcjs/jsaddle) frontend code (while opening its websocket).

78−

79−#### Longer version:

80−

81−Assuming we are in a project created with `ob init`, `ob run` calls (see

82−`lib/command/src/Obelisk/Command.hs`):

83−

84− nix-shell --pure -A shells.ghc --run 'ob --no-handoff internal run-static-io <real-run-function>'

85−

86−where

87−

88−* `shells.ghc` is defined in `./default.nix` by importing `./.obelisk/impl/default.nix` which

89− is `default.nix` in the present (Obelisk) repository,

90−* `run-static-io` is a logging-enabled command wrapper

91− (cf. `runObelisk` in `lib/command/src/Obelisk/App.hs`).

92−

93−In this case, it runs the function `Obelisk.Command.Command.run` (defined in

94−`lib/command/src/Obelisk/Command/Run.hs`).

95−

96−* It creates a GHCi config from a Nix expression which:

97− * loads three packages: `backend`, `common`, `frontend`,

98− * obtains a free port number.

99−* Then runs `ghcid`

100− * with a command that reruns `Obelisk.Run.run` at each restart (option

101− `--test`).

102−

103−It is defined in `lib/run/src/Obelisk/Run.hs`:

104−

105−* It creates a thread which starts the main backend.

106− This runs `runSnapWithCommandLineArgs` and passes routes:

107− * to the backend (result of the `_backend_run` field of your

108− implementation of the `Backend fullRoute frontendRoute` record),

109− * or to `serveDefaultObeliskApp` (`lib/backend/src/Obelisk/Backend.hs`) to

110− serve static assets.

111−* Starts `runWidget`

112− which itself runs

113− [runSettingsSocket](https://hackage.haskell.org/package/warp-3.2.26/docs/Network-Wai-Handler-Warp.html#v:runSettingsSocket)

114− (the *“TCP listen loop”*):

115− * it binds to TCP socket, and

116− * creates the HTTP connection manager

117− ( [`newManager`](https://hackage.haskell.org/package/http-client-0.6.3/docs/Network-HTTP-Client.html#v:newManager))

118− * calls `obeliskApp` which

119− * has a route to serve the [JSaddle](https://github.com/ghcjs/jsaddle) frontend,

120− * runs the frontend (*on* the server), to produce pre-rendered pages,

121− * starts the JSaddle web-socket,

122− * “falls back” to proxying the backend (`fallbackProxy`).

README.md+71−129

@@ -1,93 +1,75 @@

1# Obelisk

2

3[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org)

4−[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)

4+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://github.com/obsidiansystems/obelisk/blob/master/LICENSE)

5

6+<p align="center"><img src="docs/obelisk-logo-640.png" width="50%" alt="Obelisk Logo"></p>

6

7

7−Obelisk provides an easy way to develop and deploy your [Reflex](https://github.com/reflex-frp/reflex) project as web apps and as mobile apps.

8+Functional reactive web and mobile applications, with batteries included. Obelisk's goal is to represent a cohesive, highly-curated set of choices that [Obsidian Systems](https://obsidian.systems/) has made for building these types of applications in a way that is extremely fast but does not compromise on production readiness.

8

9

10+- [Overview](#overview)

11+ - [Who should consider using it?](#who-should-consider-using-it)

9- [Installing Obelisk](#installing-obelisk)

12- [Installing Obelisk](#installing-obelisk)

10- [Developing an Obelisk project](#developing-an-obelisk-project)

13- [Developing an Obelisk project](#developing-an-obelisk-project)

11− - [Adding Packages](#adding-packages)

14+ - [IDE Support](#ide-support)

12− - [Adding Package Overrides](#adding-package-overrides)

13− - [Running over https](#running-over-https)

14- [Deploying](#deploying)

15- [Deploying](#deploying)

15− - [Locally](#locally)

16 - [Default EC2 Deployment](#default-ec2-deployment)

17 - [Custom Non-EC2 Deployment](#custom-non-ec2-deployment)

18 - [VirtualBox Deployment](#virtualbox-deployment)

19+ - [Locally](#locally)

19 - [From macOS](#from-macos)

20 - [From macOS](#from-macos)

20 - [Deploying an updated version](#deploying-an-updated-version)

21 - [Deploying an updated version](#deploying-an-updated-version)

21- [Mobile](#mobile)

22- [Mobile](#mobile)

22 - [iOS](#ios)

23 - [iOS](#ios)

23 - [Android](#android)

24 - [Android](#android)

25+- [Frequently Asked Questions (FAQ)](#frequently-asked-questions-faq)

26+- [Contributing](#contributing)

27+

28+## Overview

29+

30+Obelisk allows you to build high-quality web and mobile applications very quickly using [Reflex](https://reflex-frp.org/). In minutes you can go from an empty directory to an interactive application that works on web, iOS, and Android, all sharing the same Haskell codebase! Obelisk's development environment also enables extremely rapid development and feedback. You can take advantage of Haskell's type system across the frontend and backend boundary. This means changes to your backend that would break your frontend are immediately detected during development and vice versa. Obelisk uses Haskell's compiler to give you a complete "TODO list" of what needs to be updated.

31+

32+Obelisk is targeted primarily at Haskell developers who want to build high-quality web and/or mobile applications in Haskell, without the distractions of manually choosing and integrating technology for every piece of the system.

33+

34+### Who should consider using it?

35+

36+Obelisk assumes basic knowledge of [Haskell](https://www.haskell.org/) and [Reflex/Reflex-DOM](https://reflex-frp.org/), web technologies like [HTML](https://developer.mozilla.org/en-US/docs/Web/HTML) and [CSS](https://developer.mozilla.org/en-US/docs/Web/CSS), and a terminal shell like [Bash](https://en.wikipedia.org/wiki/Bash_(Unix_shell)). Knowledge of [Nix](https://nixos.org/) helps but is not strictly necessary.

37+

24

38

25## Installing Obelisk

39## Installing Obelisk

40+

261. [Install Nix](https://nixos.org/nix/).

411. [Install Nix](https://nixos.org/nix/).

27 If you already have Nix installed, make sure you have version 2.0 or higher. To check your current version, run `nix-env --version`.

42 If you already have Nix installed, make sure you have version 2.0 or higher. To check your current version, run `nix-env --version`.

281. Set up nix caches

431. Set up nix caches

29 1. If you are running NixOS, add this to `/etc/nixos/configuration.nix`:

44 1. If you are running NixOS, add this to `/etc/nixos/configuration.nix`:

30− ```

45+ ```nix

31 nix.binaryCaches = [ "https://nixcache.reflex-frp.org" ];

46 nix.binaryCaches = [ "https://nixcache.reflex-frp.org" ];

32 nix.binaryCachePublicKeys = [ "ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=" ];

47 nix.binaryCachePublicKeys = [ "ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=" ];

33 ```

48 ```

34 and rebuild your NixOS configuration (e.g. `sudo nixos-rebuild switch`).

49 and rebuild your NixOS configuration (e.g. `sudo nixos-rebuild switch`).

35− 1. If you are using another operating system or linux distribution, ensure that these lines are present in your Nix configuration file (`/etc/nix/nix.conf` on most systems; [see full list](https://nixos.org/nix/manual/#sec-conf-file)):

50+ 1. If you are using another operating system or Linux distribution, ensure that these lines are present in your Nix configuration file (`/etc/nix/nix.conf` on most systems; [see full list](https://nixos.org/nix/manual/#sec-conf-file)):

36− ```

51+ ```nix

37− binary-caches = https://cache.nixos.org https://nixcache.reflex-frp.org

52+ binary-caches = https://cache.nixos.org https://nixcache.reflex-frp.org

38− binary-cache-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=

53+ binary-cache-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=

39− binary-caches-parallel-connections = 40

54+ binary-caches-parallel-connections = 40

40 ```

55 ```

41− * other Linux: enable sandboxing (see these [issue172](https://github.com/obsidiansystems/obelisk/issues/172#issuecomment-411507818) or [issue6](https://github.com/obsidiansystems/obelisk/issues/6) if you run into build problems)

56+ * If you're on a Linux distribution other than NixOS, enable sandboxing (see these [issue 172](https://github.com/obsidiansystems/obelisk/issues/172#issuecomment-411507818) or [issue 6](https://github.com/obsidiansystems/obelisk/issues/6) if you run into build problems) by adding the following:

42− ```

57+ ```nix

43 sandbox = true

58 sandbox = true

44 ```

59 ```

45− * MacOS: disable sandboxing (there are still some impure dependencies for now)

60+ * If you're on MacOS, disable sandboxing (there are still some impure dependencies for now) by adding the following:

46− ```

61+ ```nix

47 sandbox = false

62 sandbox = false

48 ```

63 ```

49 then restart the nix daemon

64 then restart the nix daemon

50− ```

65+ ```bash

51 sudo launchctl stop org.nixos.nix-daemon

66 sudo launchctl stop org.nixos.nix-daemon

52 sudo launchctl start org.nixos.nix-daemon

67 sudo launchctl start org.nixos.nix-daemon

53 ```

68 ```

69+1. Install obelisk:

70+ ```bash

54−1. Install obelisk: `nix-env -f https://github.com/obsidiansystems/obelisk/archive/master.tar.gz -iA command`

71+ nix-env -f https://github.com/obsidiansystems/obelisk/archive/master.tar.gz -iA command

55−

56−### Contributing to Obelisk

57−

58−When developing on obelisk itself you may launch `ghcid` for the corresponding project as follows. For example to launch ghcid for `lib/backend` project:

59−

60−```bash

61−nix-shell -A obeliskEnvs.obelisk-backend --run "cd lib/backend && ghcid -c 'cabal new-repl'"

62−```

63−

64−Or to launch ghcid for `lib/command` project:

65−

66−```bash

67−nix-shell -A obeliskEnvs.obelisk-command --run "cd lib/command && ghcid -c 'cabal new-repl'"

68−```

69−

70−To re-install `ob` from source do

71−```bash

72−nix-env -f /path/to/obelisk -iA command

73−```

74−

75−Note that `ob` will defer to the version found in your project's `.obelisk/impl` directory. To update that version specifically:

76−

77−```bash

78−ob thunk unpack ./.obelisk/impl

79−cd ./.obelisk/impl

80−# apply your changes

81−```

82−

83−If you want to commit your changes, first push them to your fork of obelisk and then

84−

85−```bash

86−cd /your/project/root

87−ob thunk pack .obelisk/impl

88−git add .obelisk/impl

89−git commit -m "Bump obelisk"

90−```

72+ ```

91

73

92### Accessing private repositories

74### Accessing private repositories

93

75

@@ -117,81 +99,12 @@ Firefox will not be able to properly run the development website due to [issue 4

117

99

118Every time you change the Haskell source files in frontend, common or backend, `ob run` will automatically recompile the modified files and reload the server. Furthermore, it will display on screen compilation errors and warnings if any.

100Every time you change the Haskell source files in frontend, common or backend, `ob run` will automatically recompile the modified files and reload the server. Furthermore, it will display on screen compilation errors and warnings if any.

119

101

120−### Adding packages

102+### IDE Support

121−

122−In order to add package dependencies, declare them under the build-depends field in the appropriate cabal files (backend, common, and frontend each have their own). The corresponding Nix packages will automatically be selected when building.

123−

124−### Adding package overrides

125−

126−To add a version override to any Haskell package, or to add a Haskell package that doesn't exist in the nixpkgs used by Obelisk, use the `overrides` attribute in your project's `default.nix`. For example, to use a specific version of the `aeson` package fetched from GitHub and a specific version of the `waargonaut` package fetched from Hackage, your `default.nix` will look like:

127−

128−```nix

129−# ...

130−project ./. ({ pkgs, ... }: {

131−# ...

132− overrides = self: super: let

133− aesonSrc = pkgs.fetchFromGitHub {

134− owner = "obsidiansystems";

135− repo = "aeson-gadt-th";

136− rev = "ed573c2cccf54d72aa6279026752a3fecf9c1383";

137− sha256 = "08q6rnz7w9pn76jkrafig6f50yd0f77z48rk2z5iyyl2jbhcbhx3";

138− };

139− in

140− {

141− aeson = self.callCabal2nix "aeson" aesonSrc {};

142− waargonaut = self.callHackageDirect {

143− pkg = "waargonaut";

144− ver = "0.8.0.1";

145− sha256 = "1zv28np3k3hg378vqm89v802xr0g8cwk7gy3mr77xrzy5jbgpa39";

146− } {};

147− };

148−# ...

149−```

150−

151−For further information see [the Haskell section](https://nixos.org/nixpkgs/manual/#users-guide-to-the-haskell-infrastructure) of nixpkgs Contributors Guide.

152−

153−### Adding extra local packages

154−

155−If the standard packages (`frontend`, `backend`, and `common`) are not

156−enough, to add more local Haskell packages, define them with the

157−`packages` parameter. The sources of these packages will be

158−automatically reloaded by `ob run`.

159−

160−```nix

161−# ...

162−project ./. ({ pkgs, ... }: {

163−# ...

164− packages = {

165− another = ./another;

166− };

167−# ...

168−```

169

103

170−### Running over HTTPS

104+Obelisk officially supports terminal-based feedback (akin to [`ghcid`](https://github.com/ndmitchell/ghcid)) in `ob run` and `ob watch`.

171−

172−To run your app locally over https, update the protocol in `config/common/route` to `https`, and then use `ob run` as normal.

173−

174−Since Obelisk generates a self-signed certificate for running https, the browser will issue a warning about using an invalid certificate. On Chrome, you can go to `chrome://flags/#allow-insecure-localhost` to enable invalid certificates for localhost.

175

105

176## Deploying

106## Deploying

177

107

178−### Locally

179−

180−Build everything:

181−

182−```bash

183−nix-build -A exe --no-out-link

184−```

185−

186−Copy the result to a new directory, add configuration, and run!

187−

188−```bash

189−mkdir test-app

190−ln -s $(nix-build -A exe --no-out-link)/* test-app/

191−cp -r config test-app

192−(cd test-app && ./backend)

193−```

194−

195### Default EC2 Deployment

108### Default EC2 Deployment

196

109

197In this section we will demonstrate how to deploy your Obelisk app to an Amazon EC2 instance. Obelisk deployments are configured for EC2 by default (see [Custom Non-EC2 Deployment](#custom-non-ec2-deployment)).

110In this section we will demonstrate how to deploy your Obelisk app to an Amazon EC2 instance. Obelisk deployments are configured for EC2 by default (see [Custom Non-EC2 Deployment](#custom-non-ec2-deployment)).

@@ -201,14 +114,14 @@ First create a new EC2 instance:

2011. Launch a NixOS 19.09 EC2 instance (we recommend [this AMI](https://console.aws.amazon.com/ec2/v2/home?region=us-east-1#LaunchInstanceWizard:ami=ami-00a8eeaf232a74f84))

1141. Launch a NixOS 19.09 EC2 instance (we recommend [this AMI](https://console.aws.amazon.com/ec2/v2/home?region=us-east-1#LaunchInstanceWizard:ami=ami-00a8eeaf232a74f84))

2021. In the instance configuration wizard ensure that your instance has at least 1GB RAM and 10GB disk space.

1151. In the instance configuration wizard ensure that your instance has at least 1GB RAM and 10GB disk space.

2031. When prompted save your AWS private key (`~/myaws.pem`) somewhere safe. We'll need it later during deployment.

1161. When prompted save your AWS private key (`~/myaws.pem`) somewhere safe. We'll need it later during deployment.

204−1. Go to "Security Groups", select your instance's security group and under "Inbound" tab add a new rule for HTTP port 80 and 443.

117+1. Go to "Security Groups", select your instance's security group and under "Inbound" tab add a new rule for HTTP port 80 and HTTPS port 443.

205

118

206At this stage your instance should be booting and become accessible shortly. Note down the hostname of your EC2 instance.

119At this stage your instance should be booting and become accessible shortly. Note down the hostname of your EC2 instance.

207

120

208Now go to your Obelisk project directory (`~/code/myapp`), and initialize a deployment config (`~/code/myapp-deploy`):

121Now go to your Obelisk project directory (`~/code/myapp`), and initialize a deployment config (`~/code/myapp-deploy`):

209Your project directory must be "thunkable", i.e. something on which `ob thunk pack` can be called. Usually it will be a git repository whose current revision has been pushed upstream.

122Your project directory must be "thunkable", i.e. something on which `ob thunk pack` can be called. Usually it will be a git repository whose current revision has been pushed upstream.

210

123

211−```

124+```bash

212cd ~/code/myapp

125cd ~/code/myapp

213SERVER=ec2-35-183-22-197.ca-central-1.compute.amazonaws.com

126SERVER=ec2-35-183-22-197.ca-central-1.compute.amazonaws.com

214ROUTE=https://myapp.com # Publicly accessible route to your app

127ROUTE=https://myapp.com # Publicly accessible route to your app

@@ -227,7 +140,7 @@ This step will also require that you manually verify the authenticity of the hos

227

140

228Next, go to the deployment directory that you just initialized and deploy!

141Next, go to the deployment directory that you just initialized and deploy!

229

142

230−```

143+```bash

231cd ~/code/myapp-deploy

144cd ~/code/myapp-deploy

232ob deploy push

145ob deploy push

233```

146```

@@ -256,6 +169,25 @@ Here's a `module.nix` that is configured for deployment to a VirtualBox VM (runn

256

169

257The `{...}:` and following is the [NixOS module](https://nixos.org/nixos/manual/index.html#sec-writing-modules) definition.

170The `{...}:` and following is the [NixOS module](https://nixos.org/nixos/manual/index.html#sec-writing-modules) definition.

258

171

172+### Locally

173+

174+If you want deploy your application locally or test a production-oriented build you can build and deploy the app as described below.

175+

176+Build the application:

177+

178+```bash

179+nix-build -A exe --no-out-link

180+```

181+

182+Copy the result to a new directory, add configuration, and run!

183+

184+```bash

185+mkdir test-app

186+ln -s $(nix-build -A exe --no-out-link)/* test-app/

187+cp -r config test-app

188+(cd test-app && ./backend)

189+```

190+

259### From macOS

191### From macOS

260

192

261Deploying from macOS requires some extra setup:

193Deploying from macOS requires some extra setup:

@@ -289,7 +221,7 @@ Your account must also belong to an Apple Developer Team, if you want to access

2891. Click accept to authorize on both the computer and the iPhone.

2211. Click accept to authorize on both the computer and the iPhone.

290

222

291##### Xcode

223##### Xcode

292−Install Xcode 8.2 (contains iOS SDK 10.2) and open it so that it runs its post install tool setup.

224+Install Xcode 11.2 (contains iOS SDK 13.2) and open it so that it runs its post install tool setup.

293

225

294These versions will work out of the box but iOS SDKs prior to 11.3 should also work. You can choose another installed version in `default.nix`

226These versions will work out of the box but iOS SDKs prior to 11.3 should also work. You can choose another installed version in `default.nix`

295

227

@@ -382,3 +314,13 @@ This should copy over and install the application on your device (if you see a

382##### Build a release version

314##### Build a release version

383

315

384After having configured signing for your app, you may proceed to build a release version of the app. This is no different to how you build the non-release version, so consult the section [Android](#android) further above for exact instructions on building and deploying to your device.

316After having configured signing for your app, you may proceed to build a release version of the app. This is no different to how you build the non-release version, so consult the section [Android](#android) further above for exact instructions on building and deploying to your device.

317+

318+

319+## Frequently Asked Questions (FAQ)

320+

321+Refer to [FAQ](FAQ.md).

322+

323+

324+## Contributing

325+

326+Contributions and issue reports are encouraged and appreciated! Refer to the [Contributing](CONTRIBUTING.md) guide for information about getting started.

acme.nixnew file+430

@@ -0,0 +1,430 @@

1+# Copied from https://github.com/NixOS/nixpkgs-channels/blob/70717a337f7ae4e486ba71a500367cad697e5f09/nixos/modules/security/acme.nix # MODIFIED

2+# Lines marked '# MODIFIED' have been added or modified from the original. # MODIFIED

3+{ config, lib, pkgs, ... }:

4+with lib;

5+let

6+

7+ cfg = config.security.acme;

8+

9+ certOpts = { name, ... }: {

10+ options = {

11+ webroot = mkOption {

12+ type = types.nullOr types.str;

13+ default = null;

14+ example = "/var/lib/acme/acme-challenges";

15+ description = ''

16+ Where the webroot of the HTTP vhost is located.

17+ <filename>.well-known/acme-challenge/</filename> directory

18+ will be created below the webroot if it doesn't exist.

19+ <literal>http://example.org/.well-known/acme-challenge/</literal> must also

20+ be available (notice unencrypted HTTP).

21+ '';

22+ };

23+

24+ server = mkOption {

25+ type = types.nullOr types.str;

26+ default = null;

27+ description = ''

28+ ACME Directory Resource URI. Defaults to let's encrypt

29+ production endpoint,

30+ https://acme-v02.api.letsencrypt.org/directory, if unset.

31+ '';

32+ };

33+

34+ domain = mkOption {

35+ type = types.str;

36+ default = name;

37+ description = "Domain to fetch certificate for (defaults to the entry name)";

38+ };

39+

40+ email = mkOption {

41+ type = types.nullOr types.str;

42+ default = cfg.email;

43+ description = "Contact email address for the CA to be able to reach you.";

44+ };

45+

46+ user = mkOption {

47+ type = types.str;

48+ default = "root";

49+ description = "User running the ACME client.";

50+ };

51+

52+ group = mkOption {

53+ type = types.str;

54+ default = "root";

55+ description = "Group running the ACME client.";

56+ };

57+

58+ allowKeysForGroup = mkOption {

59+ type = types.bool;

60+ default = false;

61+ description = ''

62+ Give read permissions to the specified group

63+ (<option>security.acme.cert.<name>.group</option>) to read SSL private certificates.

64+ '';

65+ };

66+

67+ postRun = mkOption {

68+ type = types.lines;

69+ default = "";

70+ example = "systemctl reload nginx.service";

71+ description = ''

72+ Commands to run after new certificates go live. Typically

73+ the web server and other servers using certificates need to

74+ be reloaded.

75+ Executed in the same directory with the new certificate.

76+ '';

77+ };

78+

79+ directory = mkOption {

80+ type = types.str;

81+ readOnly = true;

82+ default = "/var/lib/acme/${name}";

83+ description = "Directory where certificate and other state is stored.";

84+ };

85+

86+ extraDomains = mkOption {

87+ type = types.attrsOf (types.nullOr types.str);

88+ default = {};

89+ example = literalExample ''

90+ {

91+ "example.org" = null;

92+ "mydomain.org" = null;

93+ }

94+ '';

95+ description = ''

96+ A list of extra domain names, which are included in the one certificate to be issued.

97+ Setting a distinct server root is deprecated and not functional in 20.03+

98+ '';

99+ };

100+

101+ keyType = mkOption {

102+ type = types.str;

103+ default = "ec256";

104+ description = ''

105+ Key type to use for private keys.

106+ For an up to date list of supported values check the --key-type option

107+ at https://go-acme.github.io/lego/usage/cli/#usage.

108+ '';

109+ };

110+

111+ dnsProvider = mkOption {

112+ type = types.nullOr types.str;

113+ default = null;

114+ example = "route53";

115+ description = ''

116+ DNS Challenge provider. For a list of supported providers, see the "code"

117+ field of the DNS providers listed at https://go-acme.github.io/lego/dns/.

118+ '';

119+ };

120+

121+ credentialsFile = mkOption {

122+ type = types.path;

123+ description = ''

124+ Path to an EnvironmentFile for the cert's service containing any required and

125+ optional environment variables for your selected dnsProvider.

126+ To find out what values you need to set, consult the documentation at

127+ https://go-acme.github.io/lego/dns/ for the corresponding dnsProvider.

128+ '';

129+ example = "/var/src/secrets/example.org-route53-api-token";

130+ };

131+

132+ dnsPropagationCheck = mkOption {

133+ type = types.bool;

134+ default = true;

135+ description = ''

136+ Toggles lego DNS propagation check, which is used alongside DNS-01

137+ challenge to ensure the DNS entries required are available.

138+ '';

139+ };

140+ };

141+ };

142+

143+in

144+

145+{

146+

147+ ###### interface

148+ imports = [

149+ (mkRemovedOptionModule [ "security" "acme" "production" ] ''

150+ Use security.acme.server to define your staging ACME server URL instead.

151+ To use the let's encrypt staging server, use security.acme.server =

152+ "https://acme-staging-v02.api.letsencrypt.org/directory".

153+ ''

154+ )

155+ # (mkRemovedOptionModule [ "security" "acme" "directory"] "ACME Directory is now hardcoded to /var/lib/acme and its permisisons are managed by systemd. See https://github.com/NixOS/nixpkgs/issues/53852 for more info.") # MODIFIED

156+ # (mkRemovedOptionModule [ "security" "acme" "preDelay"] "This option has been removed. If you want to make sure that something executes before certificates are provisioned, add a RequiredBy=acme-\${cert}.service to the service you want to execute before the cert renewal") # MODIFIED

157+ # (mkRemovedOptionModule [ "security" "acme" "activationDelay"] "This option has been removed. If you want to make sure that something executes before certificates are provisioned, add a RequiredBy=acme-\${cert}.service to the service you want to execute before the cert renewal") # MODIFIED

158+ (mkChangedOptionModule [ "security" "acme" "validMin"] [ "security" "acme" "validMinDays"] (config: config.security.acme.validMin / (24 * 3600)))

159+ ];

160+ options = {

161+ security.acme = {

162+

163+ validMinDays = mkOption {

164+ type = types.int;

165+ default = 30;

166+ description = "Minimum remaining validity before renewal in days.";

167+ };

168+

169+ email = mkOption {

170+ type = types.nullOr types.str;

171+ default = null;

172+ description = "Contact email address for the CA to be able to reach you.";

173+ };

174+

175+ renewInterval = mkOption {

176+ type = types.str;

177+ default = "daily";

178+ description = ''

179+ Systemd calendar expression when to check for renewal. See

180+ <citerefentry><refentrytitle>systemd.time</refentrytitle>

181+ <manvolnum>7</manvolnum></citerefentry>.

182+ '';

183+ };

184+

185+ server = mkOption {

186+ type = types.nullOr types.str;

187+ default = null;

188+ description = ''

189+ ACME Directory Resource URI. Defaults to let's encrypt

190+ production endpoint,

191+ <literal>https://acme-v02.api.letsencrypt.org/directory</literal>, if unset.

192+ '';

193+ };

194+

195+ preliminarySelfsigned = mkOption {

196+ type = types.bool;

197+ default = true;

198+ description = ''

199+ Whether a preliminary self-signed certificate should be generated before

200+ doing ACME requests. This can be useful when certificates are required in

201+ a webserver, but ACME needs the webserver to make its requests.

202+ With preliminary self-signed certificate the webserver can be started and

203+ can later reload the correct ACME certificates.

204+ '';

205+ };

206+

207+ acceptTerms = mkOption {

208+ type = types.bool;

209+ default = false;

210+ description = ''

211+ Accept the CA's terms of service. The default provier is Let's Encrypt,

212+ you can find their ToS at https://letsencrypt.org/repository/

213+ '';

214+ };

215+

216+ certs = mkOption {

217+ default = { };

218+ type = with types; attrsOf (submodule certOpts);

219+ description = ''

220+ Attribute set of certificates to get signed and renewed. Creates

221+ <literal>acme-''${cert}.{service,timer}</literal> systemd units for

222+ each certificate defined here. Other services can add dependencies

223+ to those units if they rely on the certificates being present,

224+ or trigger restarts of the service if certificates get renewed.

225+ '';

226+ example = literalExample ''

227+ {

228+ "example.com" = {

229+ webroot = "/var/www/challenges/";

230+ email = "foo@example.com";

231+ extraDomains = { "www.example.com" = null; "foo.example.com" = null; };

232+ };

233+ "bar.example.com" = {

234+ webroot = "/var/www/challenges/";

235+ email = "bar@example.com";

236+ };

237+ }

238+ '';

239+ };

240+ };

241+ };

242+

243+ ###### implementation

244+ config = mkMerge [

245+ (mkIf (cfg.certs != { }) {

246+

247+ assertions = let

248+ certs = (mapAttrsToList (k: v: v) cfg.certs);

249+ in [

250+ {

251+ assertion = all (certOpts: certOpts.dnsProvider == null || certOpts.webroot == null) certs;

252+ message = ''

253+ Options `security.acme.certs.<name>.dnsProvider` and

254+ `security.acme.certs.<name>.webroot` are mutually exclusive.

255+ '';

256+ }

257+ {

258+ assertion = cfg.email != null || all (certOpts: certOpts.email != null) certs;

259+ message = ''

260+ You must define `security.acme.certs.<name>.email` or

261+ `security.acme.email` to register with the CA.

262+ '';

263+ }

264+ {

265+ assertion = cfg.acceptTerms;

266+ message = ''

267+ You must accept the CA's terms of service before using

268+ the ACME module by setting `security.acme.acceptTerms`

269+ to `true`. For Let's Encrypt's ToS see https://letsencrypt.org/repository/

270+ '';

271+ }

272+ ];

273+

274+ systemd.services = let

275+ services = concatLists servicesLists;

276+ servicesLists = mapAttrsToList certToServices cfg.certs;

277+ certToServices = cert: data:

278+ let

279+ # StateDirectory must be relative, and will be created under /var/lib by systemd

280+ lpath = "acme/${cert}";

281+ apath = "/var/lib/${lpath}";

282+ spath = "/var/lib/acme/.lego/${cert}";

283+ fileMode = if data.allowKeysForGroup then "640" else "600";

284+ globalOpts = [ "-d" data.domain "--email" data.email "--path" "." "--key-type" data.keyType ]

285+ ++ optionals (cfg.acceptTerms) [ "--accept-tos" ]

286+ ++ optionals (data.dnsProvider != null && !data.dnsPropagationCheck) [ "--dns.disable-cp" ]

287+ ++ concatLists (mapAttrsToList (name: root: [ "-d" name ]) data.extraDomains)

288+ ++ (if data.dnsProvider != null then [ "--dns" data.dnsProvider ] else [ "--http" "--http.webroot" data.webroot ])

289+ ++ optionals (cfg.server != null || data.server != null) ["--server" (if data.server == null then cfg.server else data.server)];

290+ runOpts = escapeShellArgs (globalOpts ++ [ "run" ]);

291+ renewOpts = escapeShellArgs (globalOpts ++ [ "renew" "--days" (toString cfg.validMinDays) ]);

292+ acmeService = {

293+ description = "Renew ACME Certificate for ${cert}";

294+ after = [ "network.target" "network-online.target" ];

295+ wants = [ "network-online.target" ];

296+ wantedBy = mkIf (!config.boot.isContainer) [ "multi-user.target" ];

297+ serviceConfig = {

298+ Type = "oneshot";

299+ User = data.user;

300+ Group = data.group;

301+ PrivateTmp = true;

302+ StateDirectory = "acme/.lego/${cert} acme/.lego/accounts ${lpath}";

303+ StateDirectoryMode = if data.allowKeysForGroup then "750" else "700";

304+ WorkingDirectory = spath;

305+ # Only try loading the credentialsFile if the dns challenge is enabled

306+ EnvironmentFile = if data.dnsProvider != null then data.credentialsFile else null;

307+ ExecStart = pkgs.writeScript "acme-start" ''

308+ #!${pkgs.runtimeShell} -e

309+ test -L ${spath}/accounts -o -d ${spath}/accounts || ln -s ../accounts ${spath}/accounts

310+ ${pkgs.lego}/bin/lego ${renewOpts} || ${pkgs.lego}/bin/lego ${runOpts}

311+ '';

312+ ExecStartPost =

313+ let

314+ keyName = builtins.replaceStrings ["*"] ["_"] data.domain;

315+ script = pkgs.writeScript "acme-post-start" ''

316+ #!${pkgs.runtimeShell} -e

317+ cd ${apath}

318+ # Test that existing cert is older than new cert

319+ KEY=${spath}/certificates/${keyName}.key

320+ KEY_CHANGED=no

321+ if [ -e $KEY -a $KEY -nt key.pem ]; then

322+ KEY_CHANGED=yes

323+ cp -p ${spath}/certificates/${keyName}.key key.pem

324+ cp -p ${spath}/certificates/${keyName}.crt fullchain.pem

325+ cp -p ${spath}/certificates/${keyName}.issuer.crt chain.pem

326+ ln -sf fullchain.pem cert.pem

327+ cat key.pem fullchain.pem > full.pem

328+ fi

329+ chmod ${fileMode} *.pem

330+ chown '${data.user}:${data.group}' *.pem

331+ if [ "$KEY_CHANGED" = "yes" ]; then

332+ : # noop in case postRun is empty

333+ ${data.postRun}

334+ fi

335+ '';

336+ in

337+ "+${script}";

338+ };

339+

340+ };

341+ selfsignedService = {

342+ description = "Create preliminary self-signed certificate for ${cert}";

343+ path = [ pkgs.openssl ];

344+ script =

345+ ''

346+ workdir="$(mktemp -d)"

347+ # Create CA

348+ openssl genrsa -des3 -passout pass:xxxx -out $workdir/ca.pass.key 2048

349+ openssl rsa -passin pass:xxxx -in $workdir/ca.pass.key -out $workdir/ca.key

350+ openssl req -new -key $workdir/ca.key -out $workdir/ca.csr \

351+ -subj "/C=UK/ST=Warwickshire/L=Leamington/O=OrgName/OU=Security Department/CN=example.com"

352+ openssl x509 -req -days 1 -in $workdir/ca.csr -signkey $workdir/ca.key -out $workdir/ca.crt

353+ # Create key

354+ openssl genrsa -des3 -passout pass:xxxx -out $workdir/server.pass.key 2048

355+ openssl rsa -passin pass:xxxx -in $workdir/server.pass.key -out $workdir/server.key

356+ openssl req -new -key $workdir/server.key -out $workdir/server.csr \

357+ -subj "/C=UK/ST=Warwickshire/L=Leamington/O=OrgName/OU=IT Department/CN=example.com"

358+ openssl x509 -req -days 1 -in $workdir/server.csr -CA $workdir/ca.crt \

359+ -CAkey $workdir/ca.key -CAserial $workdir/ca.srl -CAcreateserial \

360+ -out $workdir/server.crt

361+ # Copy key to destination

362+ cp $workdir/server.key ${apath}/key.pem

363+ # Create fullchain.pem (same format as "simp_le ... -f fullchain.pem" creates)

364+ cat $workdir/{server.crt,ca.crt} > "${apath}/fullchain.pem"

365+ # Create full.pem for e.g. lighttpd

366+ cat $workdir/{server.key,server.crt,ca.crt} > "${apath}/full.pem"

367+ # Give key acme permissions

368+ chown '${data.user}:${data.group}' "${apath}/"{key,fullchain,full}.pem

369+ chmod ${fileMode} "${apath}/"{key,fullchain,full}.pem

370+ '';

371+ serviceConfig = {

372+ Type = "oneshot";

373+ PrivateTmp = true;

374+ StateDirectory = lpath;

375+ User = data.user;

376+ Group = data.group;

377+ };

378+ unitConfig = {

379+ # Do not create self-signed key when key already exists

380+ ConditionPathExists = "!${apath}/key.pem";

381+ };

382+ };

383+ in (

384+ [ { name = "acme-${cert}"; value = acmeService; } ]

385+ ++ optional cfg.preliminarySelfsigned { name = "acme-selfsigned-${cert}"; value = selfsignedService; }

386+ );

387+ servicesAttr = listToAttrs services;

388+ in

389+ servicesAttr;

390+

391+ systemd.tmpfiles.rules =

392+ map (data: "d ${data.webroot}/.well-known/acme-challenge - ${data.user} ${data.group}") (filter (data: data.webroot != null) (attrValues cfg.certs));

393+

394+ systemd.timers = let

395+ # Allow systemd to pick a convenient time within the day

396+ # to run the check.

397+ # This allows the coalescing of multiple timer jobs.

398+ # We divide by the number of certificates so that if you

399+ # have many certificates, the renewals are distributed over

400+ # the course of the day to avoid rate limits.

401+ numCerts = length (attrNames cfg.certs);

402+ _24hSecs = 60 * 60 * 24;

403+ AccuracySec = "${toString (_24hSecs / numCerts)}s";

404+ in flip mapAttrs' cfg.certs (cert: data: nameValuePair

405+ ("acme-${cert}")

406+ ({

407+ description = "Renew ACME Certificate for ${cert}";

408+ wantedBy = [ "timers.target" ];

409+ timerConfig = {

410+ OnCalendar = cfg.renewInterval;

411+ Unit = "acme-${cert}.service";

412+ Persistent = "yes";

413+ inherit AccuracySec;

414+ # Skew randomly within the day, per https://letsencrypt.org/docs/integration-guide/.

415+ RandomizedDelaySec = "24h";

416+ };

417+ })

418+ );

419+

420+ systemd.targets.acme-selfsigned-certificates = mkIf cfg.preliminarySelfsigned {};

421+ systemd.targets.acme-certificates = {};

422+ })

423+

424+ ];

425+

426+ meta = {

427+ maintainers = with lib.maintainers; [ abbradar fpletz globin m1cr0man ];

428+ # doc = ./acme.xml; # MODIFIED

429+ };

430+}

all-builds.nix+15−6

@@ -1,6 +1,6 @@

1{ self-args ? {

2 config.android_sdk.accept_license = true;

3− iosSdkVersion = "10.2";

3+ iosSdkVersion = "13.2";

4 }

5, local-self ? import ./. self-args

6, supportedSystems ? [ builtins.currentSystem ]

@@ -53,19 +53,28 @@ let

53 obelisk.haskellPackageSets.ghcjs

54 obeliskPackagesCommon;

55 command = obelisk.command;

56+

57+ withSkeletonOptions = skel: options: (skel.passthru.__unstable__.self.extend (self: super: {

58+ userSettings = super.userSettings // options;

59+ })).project;

56− skeleton = import ./skeleton { inherit obelisk; };

60+ rawSkeleton = import ./skeleton { inherit obelisk; };

61+ skeleton = withSkeletonOptions rawSkeleton {

62+ withHoogle = true; # cache the Hoogle database for the skeleton

63+ __withGhcide = true; # cache the ghcide build for the skeleton

64+ };

65+

57− serverSkeletonExe = skeleton.exe;

66+ serverSkeletonExe = rawSkeleton.exe;

58 # TODO fix nixpkgs so it doesn't try to run the result of haskell shells as setup hooks.

67 # TODO fix nixpkgs so it doesn't try to run the result of haskell shells as setup hooks.

59 serverSkeletonShell = local-self.nixpkgs.runCommand "shell-safe-for-dep" {} ''

68 serverSkeletonShell = local-self.nixpkgs.runCommand "shell-safe-for-dep" {} ''

60 touch "$out"

69 touch "$out"

61 echo "return" >> "$out"

70 echo "return" >> "$out"

62 cat "${skeleton.shells.ghc}" >> "$out"

71 cat "${skeleton.shells.ghc}" >> "$out"

63 '';

72 '';

64− androidSkeleton = (import ./skeleton { inherit obelisk; }).android.frontend;

73+ androidSkeleton = skeleton.android.frontend;

65− iosSkeleton = (import ./skeleton { inherit obelisk; }).ios.frontend;

74+ iosSkeleton = skeleton.ios.frontend;

66 nameSuffix = if profiling then "profiled" else "unprofiled";

75 nameSuffix = if profiling then "profiled" else "unprofiled";

67 packages = {

76 packages = {

68− skeletonProfiledObRun = skeleton.__unstable__.profiledObRun;

77+ skeletonProfiledObRun = rawSkeleton.__unstable__.profiledObRun;

69 inherit

78 inherit

70 command

79 command

71 serverSkeletonShell

80 serverSkeletonShell

all-tests.nix+6−6

@@ -125,17 +125,17 @@ in

125 client.succeed("ob -v thunk unpack ~/code/myapp")

126

127 with subtest("building an invalid thunk fails"):

128− client.succeed("cd ~/code/myapp/local && git checkout -b bad")

128+ client.succeed("cd ~/code/myapp && git checkout -b bad")

129 client.succeed(

130− "cp ${invalidThunkableSample} ~/code/myapp/local/default.nix"

130+ "cp ${invalidThunkableSample} ~/code/myapp/default.nix"

131 )

132− client.succeed("cd ~/code/myapp/local && git add .")

132+ client.succeed("cd ~/code/myapp && git add .")

133− client.succeed('cd ~/code/myapp/local && git commit -m "Bad commit"')

133+ client.succeed('cd ~/code/myapp && git commit -m "Bad commit"')

134− client.succeed("cd ~/code/myapp/local && git push -u origin bad")

134+ client.succeed("cd ~/code/myapp && git push -u origin bad")

135 client.succeed("ob -v thunk pack ~/code/myapp --public")

136 client.fail("nix-build ~/code/myapp")

137 client.succeed("ob -v thunk unpack ~/code/myapp")

138− client.succeed("cd ~/code/myapp/local && git checkout master")

138+ client.succeed("cd ~/code/myapp && git checkout master")

139

140 with subtest("obelisk can detect private repos"):

141 client.succeed("ob -v thunk pack ~/code/myapp")

default.nix+60−27

@@ -1,7 +1,10 @@

1{ system ? builtins.currentSystem

2, profiling ? false

3−, iosSdkVersion ? "10.2"

3+, iosSdkVersion ? "13.2"

4, config ? {}

5+, terms ? { # Accepted terms, conditions, and licenses

6+ security.acme.acceptTerms = false;

7+ }

5, reflex-platform-func ? import ./dep/reflex-platform

8, reflex-platform-func ? import ./dep/reflex-platform

6}:

9}:

7let

10let

@@ -43,7 +46,7 @@ in rec {

43 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.

46 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.

44 path = reflex-platform.filterGit ./.;

47 path = reflex-platform.filterGit ./.;

45 obelisk = ghcObelisk;

48 obelisk = ghcObelisk;

46− obeliskEnvs = pkgs.lib.filterAttrs (k: _: pkgs.lib.strings.hasPrefix "obelisk-" k) ghcObeliskEnvs;

49+ obeliskEnvs = pkgs.lib.filterAttrs (k: _: k == "tabulation" || pkgs.lib.strings.hasPrefix "obelisk-" k) ghcObeliskEnvs; #TODO: use thunkSet https://github.com/reflex-frp/reflex-platform/pull/671

47 command = ghcObelisk.obelisk-command;

50 command = ghcObelisk.obelisk-command;

48 shell = pinBuildInputs "obelisk-shell" ([command] ++ command.commandRuntimeDeps);

51 shell = pinBuildInputs "obelisk-shell" ([command] ++ command.commandRuntimeDeps);

49

52

@@ -74,16 +77,20 @@ in rec {

74 '';

77 '';

75

78

76 compressedJs = frontend: optimizationLevel: pkgs.runCommand "compressedJs" {} ''

79 compressedJs = frontend: optimizationLevel: pkgs.runCommand "compressedJs" {} ''

77− mkdir $out

80+ set -euo pipefail

78− cd $out

79− # TODO profiling + static shouldn't break and need an ad-hoc workaround like that

80− ln -s "${haskellLib.justStaticExecutables frontend}/bin/frontend.jsexe/all.js" all.unminified.js

81+ cd '${haskellLib.justStaticExecutables frontend}'

82+ shopt -s globstar

83+ for f in **/all.js; do

84+ dir="$out/$(basename "$(dirname "$f")")"

85+ mkdir -p "$dir"

86+ ln -s "$(realpath "$f")" "$dir/all.unminified.js"

81− ${if optimizationLevel == null then ''

87+ ${if optimizationLevel == null then ''

82− ln -s all.unminified.js all.js

88+ ln -s "$dir/all.unminified.js" "$dir/all.js"

83− '' else ''

89+ '' else ''

84− ${pkgs.closurecompiler}/bin/closure-compiler --externs "${reflex-platform.ghcjsExternsJs}" -O ${optimizationLevel} --jscomp_warning=checkVars --create_source_map="all.js.map" --source_map_format=V3 --js_output_file="all.js" all.unminified.js

90+ '${pkgs.closurecompiler}/bin/closure-compiler' --externs '${reflex-platform.ghcjsExternsJs}' -O '${optimizationLevel}' --jscomp_warning=checkVars --create_source_map="$dir/all.js.map" --source_map_format=V3 --js_output_file="$dir/all.js" "$dir/all.unminified.js"

85− echo "//# sourceMappingURL=all.js.map" >> all.js

91+ echo '//# sourceMappingURL=all.js.map' >> "$dir/all.js"

86− ''}

92+ ''}

93+ done

87 '';

94 '';

88

95

89 serverModules = {

96 serverModules = {

@@ -109,6 +116,8 @@ in rec {

109 security.acme.certs = if enableHttps then {

116 security.acme.certs = if enableHttps then {

110 "${routeHost}".email = adminEmail;

117 "${routeHost}".email = adminEmail;

111 } else {};

118 } else {};

119+

120+ security.acme.${if enableHttps && (terms.security.acme.acceptTerms or false) then "acceptTerms" else null} = true;

112 };

121 };

113

122

114 mkObeliskApp =

123 mkObeliskApp =

@@ -125,12 +134,16 @@ in rec {

125 }: {...}: {

134 }: {...}: {

126 services.nginx = {

135 services.nginx = {

127 enable = true;

136 enable = true;

137+ recommendedProxySettings = true;

128 virtualHosts."${routeHost}" = {

138 virtualHosts."${routeHost}" = {

129 enableACME = enableHttps;

139 enableACME = enableHttps;

130 forceSSL = enableHttps;

140 forceSSL = enableHttps;

131 locations.${baseUrl} = {

141 locations.${baseUrl} = {

132 proxyPass = "http://127.0.0.1:" + toString internalPort;

142 proxyPass = "http://127.0.0.1:" + toString internalPort;

133 proxyWebsockets = true;

143 proxyWebsockets = true;

144+ extraConfig = ''

145+ access_log off;

146+ '';

134 };

147 };

135 };

148 };

136 };

149 };

@@ -171,9 +184,11 @@ in rec {

171 pkgs.runCommand "serverExe" {} ''

184 pkgs.runCommand "serverExe" {} ''

172 mkdir $out

185 mkdir $out

173 set -eux

186 set -eux

174− ln -s "${if profiling then backend else haskellLib.justStaticExecutables backend}"/bin/* $out/

187+ ln -s '${if profiling then backend else haskellLib.justStaticExecutables backend}'/bin/* $out/

175− ln -s "${mkAssets assets}" $out/static.assets

188+ ln -s '${mkAssets assets}' $out/static.assets

176− ln -s ${mkAssets (compressedJs frontend optimizationLevel)} $out/frontend.jsexe.assets

189+ for d in '${mkAssets (compressedJs frontend optimizationLevel)}'/*/; do

190+ ln -s "$d" "$out"/"$(basename "$d").assets"

191+ done

177 echo ${version} > $out/version

192 echo ${version} > $out/version

178 '';

193 '';

179

194

@@ -187,6 +202,20 @@ in rec {

187 (module { inherit exe hostName adminEmail routeHost enableHttps version; nixosPkgs = pkgs; })

202 (module { inherit exe hostName adminEmail routeHost enableHttps version; nixosPkgs = pkgs; })

188 (serverModules.mkDefaultNetworking args)

203 (serverModules.mkDefaultNetworking args)

189 (serverModules.mkObeliskApp args)

204 (serverModules.mkObeliskApp args)

205+ ./acme.nix # Backport of ACME upgrades from 20.03

206+ ];

207+

208+ # Backport of ACME upgrades from 20.03

209+ disabledModules = [

210+ (pkgs.path + /nixos/modules/security/acme.nix)

211+ ];

212+ nixpkgs.overlays = [

213+ (self: super: {

214+ lego = (import (builtins.fetchTarball {

215+ url = https://github.com/NixOS/nixpkgs-channels/archive/70717a337f7ae4e486ba71a500367cad697e5f09.tar.gz;

216+ sha256 = "1sbmqn7yc5iilqnvy9nvhsa9bx6spfq1kndvvis9031723iyymd1";

217+ }) {}).lego;

218+ })

190 ];

219 ];

191 };

220 };

192 };

221 };

@@ -321,29 +350,33 @@ in rec {

321 __unstable__.profiledObRun = let

350 __unstable__.profiledObRun = let

322 profiled = projectOut { inherit system; enableLibraryProfiling = true; };

351 profiled = projectOut { inherit system; enableLibraryProfiling = true; };

323 exeSource = builtins.toFile "ob-run.hs" ''

352 exeSource = builtins.toFile "ob-run.hs" ''

353+ {-# LANGUAGE NoImplicitPrelude #-}

354+ {-# LANGUAGE PackageImports #-}

324 module Main where

355 module Main where

325

356

357+ -- Explicitly import Prelude from base lest there be multiple modules called Prelude

358+ import "base" Prelude (IO, (++), read)

359+

326− import Control.Exception

360+ import "base" Control.Exception (finally)

327− import Reflex.Profiled

361+ import "reflex" Reflex.Profiled (writeProfilingData)

328− import System.Environment

362+ import "base" System.Environment (getArgs)

329

363

330− import qualified Obelisk.Run

364+ import qualified "obelisk-run" Obelisk.Run

331 import qualified Frontend

365 import qualified Frontend

332 import qualified Backend

366 import qualified Backend

333

367

334 main :: IO ()

368 main :: IO ()

335 main = do

369 main = do

336− args <- getArgs

370+ [portStr, assets, profFileName] <- getArgs

337− let port = read $ args !! 0

338− assets = args !! 1

339− profileFile = (args !! 2) <> ".rprof"

340− Obelisk.Run.run port (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend `finally` writeProfilingData profileFile

371+ Obelisk.Run.run (read portStr) (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend

372+ `finally` writeProfilingData (profFileName ++ ".rprof")

341 '';

373 '';

342 in nixpkgs.runCommand "ob-run" {

374 in nixpkgs.runCommand "ob-run" {

343− buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];

375+ buildInputs = [ (profiled.ghc.ghcWithPackages (p: [p.backend p.frontend])) ];

344 } ''

376 } ''

377+ cp ${exeSource} ob-run.hs

345− mkdir -p $out/bin/

378+ mkdir -p $out/bin

346− ghc -x hs -prof -fno-prof-auto -threaded ${exeSource} -o $out/bin/ob-run

379+ ghc -x hs -prof -fno-prof-auto -threaded ob-run.hs -o $out/bin/ob-run

347 '';

380 '';

348

381

349 linuxExeConfigurable = linuxExe;

382 linuxExeConfigurable = linuxExe;

dep/.gitignoredeleted−5

@@ -1,5 +0,0 @@

1−*

2−!*/

3−!.gitignore

4−!*/*.json

5−!*/default.nix

dep/reflex-platform/default.nix+1−7

@@ -1,8 +1,2 @@

1# DO NOT HAND-EDIT THIS FILE

2−let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:

2+import (import ./thunk.nix)

3− if !fetchSubmodules && !private then builtins.fetchTarball {

4− url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;

5− } else (import <nixpkgs> {}).fetchFromGitHub {

6− inherit owner repo rev sha256 fetchSubmodules private;

7− };

8−in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))

dep/reflex-platform/github.json+4−4

@@ -1,8 +1,8 @@

1{

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4− "branch": "master",

4+ "branch": "release/0.7.0.0",

5 "private": false,

6− "rev": "41be4d952b75515a037318aa344dd6b13ad29cfe",

6+ "rev": "27a7851a780ff21472d85f9a02fb84635ef9027a",

7− "sha256": "132yqzyzd3c5fjy7wwnwa5d6pjxv5ap2xz0swwbv3h5pwi8jwv0a"

7+ "sha256": "1m4zlw91dpjlbdchjyxhvhv3k7lilm0qa17dhhww868xxc27sann"

8−}

8+}

dep/reflex-platform/thunk.nixnew file+9

@@ -0,0 +1,9 @@

1+# DO NOT HAND-EDIT THIS FILE

2+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:

3+ if !fetchSubmodules && !private then builtins.fetchTarball {

4+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;

5+ } else (import <nixpkgs> {}).fetchFromGitHub {

6+ inherit owner repo rev sha256 fetchSubmodules private;

7+ };

8+ json = builtins.fromJSON (builtins.readFile ./github.json);

9+in fetch json

docs/obelisk-logo-640.pngnew file

Binary file not shown.

guides/app-deploy/README.md+25−12

@@ -1,13 +1,14 @@

1# Obelisk Application Deployment Guide

2+

2This document serves two purposes, the first one is to guide new users that want to deploy Obelisk/Reflex apps and the second one to provide a walk-through for test driving Obelisk releases.

3This document serves two purposes, the first one is to guide new users that want to deploy Obelisk/Reflex apps and the second one to provide a walk-through for test driving Obelisk releases.

3

4

4−> **Note:** To complete this *entire* guide you need access to a macOS machine running the latest OSX release, a Linux machine (can be a VM on that mac) with Nix installed, an iPhone or iPad, and a recent Android device. It also assumes that you have Nix correctly set up and that your system is set up to fetch from binary caches instead of building everything on your machine. If you notice any of the commands below takes more than 5 minutes, then caches are not likely enabled.

5+> **Note:** This guide can be completed on a Linux host with Nix installed or a macOS host with Nix installed. Each section is labeled regarding which operating system hosts it supports. When going through the guide, start at the beginning and go through all sections that are supported on your host and merely skip sections that are not supported. The sections for iOS deployments require an iPhone or iPad device and the sections for Android deployments require an Android device. This guide assumes that you have Nix correctly set up and that your system is configured to fetch from binary caches instead of building everything on your machine. If you notice any of the commands below takes more than 5 minutes, then caches are not likely enabled.

5>

6>

6> Refer to the [Obelisk Installation Documentation](https://github.com/obsidiansystems/obelisk#installing-obelisk) for instructions on configuring the binary caches for any Nix-compatible setup.

7> Refer to the [Obelisk Installation Documentation](https://github.com/obsidiansystems/obelisk#installing-obelisk) for instructions on configuring the binary caches for any Nix-compatible setup.

7

8

8−## a) Get Obelisk

9+## a) Get Obelisk (Linux, Mac)

9

10

10−There are several ways to install Obelisk, but the one we are going to use here allows us to test a single version of Obelisk in different ways. The approach is to clone Obelisk from it's GitHub repository and start a project that uses that local check out.

11+There are several ways to install Obelisk, but the one we are going to use here allows us to test a single version of Obelisk in different ways. The approach is to clone Obelisk from its GitHub repository and start a project that uses that local check out.

11

12

12Open a terminal and run the following:

13Open a terminal and run the following:

13

14

@@ -39,7 +40,7 @@ ob init --branch "$OBELISK_BRANCH"

39

40

40> **Note:** If the `--branch` parameter is not used, then Obelisk sets your project up to look at the `master` branch from GitHub. This is quite handy for real life projects but distracting for our test drive since we want to make sure any changes we do to the Obelisk codebase (like testing a pull request) are immediately picked up.

41> **Note:** If the `--branch` parameter is not used, then Obelisk sets your project up to look at the `master` branch from GitHub. This is quite handy for real life projects but distracting for our test drive since we want to make sure any changes we do to the Obelisk codebase (like testing a pull request) are immediately picked up.

41

42

42−## b) Run the Obelisk app on localhost

43+## b) Run the Obelisk app on localhost (Linux, Mac)

43

44

44Let's test that we can run a server on localhost. This is quite easy:

45Let's test that we can run a server on localhost. This is quite easy:

45

46

@@ -52,9 +53,10 @@ Now open a browser and point it to http://localhost:8000 (or just click on this

52

53

53![](assets/app-deploy.png)

54![](assets/app-deploy.png)

54

55

55−## c) Deploy the web app on a remote machine

56+## c) Prepare a VirtualBox deploy target (Linux, Mac)

56

57

57### Import the NixOS VirtualBox appliance

58### Import the NixOS VirtualBox appliance

59+

58Install [VirtualBox](https://www.virtualbox.org/) on your machine.

60Install [VirtualBox](https://www.virtualbox.org/) on your machine.

59

61

60On NixOS, do this by adding the following line to your `/etc/nixos/configuration.nix` before the last line containing `}`:

62On NixOS, do this by adding the following line to your `/etc/nixos/configuration.nix` before the last line containing `}`:

@@ -79,7 +81,7 @@ You should now see a NixOS machine in the dashboard:

79

81

80![](assets/virtualbox-dashboard-nixos.png)

82![](assets/virtualbox-dashboard-nixos.png)

81

83

82−If you are on a network with DHCP on your wireless or network card then select right-click on the "NixOS" image and click "Settings". Go to the "Network" section and make "Attached to:" set to "Bridged Adapter".

84+If you are on a network with DHCP on your wireless or network card then right-click on the "NixOS" image and click "Settings". Go to the "Network" section and make "Attached to:" set to "Bridged Adapter".

83

85

84![](assets/virtualbox-image-settings-network.png)

86![](assets/virtualbox-image-settings-network.png)

85

87

@@ -201,7 +203,7 @@ git remote add origin "$WORKDIR/myapp-git-remote"

201git push -u origin master

203git push -u origin master

202```

204```

203

205

204−### Deploy

206+### Initialize deployment directory

205

207

206With that, we can come back to the Obelisk app and initialize the deployment:

208With that, we can come back to the Obelisk app and initialize the deployment:

207

209

@@ -216,7 +218,11 @@ Then configure the deployment for VirtualBox:

216echo '{nixosPkgs, ...}: {...}: { imports = [ (nixosPkgs.path + /nixos/modules/virtualisation/virtualbox-image.nix) ]; }' > "$WORKDIR/myappdeploy/module.nix"

218echo '{nixosPkgs, ...}: {...}: { imports = [ (nixosPkgs.path + /nixos/modules/virtualisation/virtualbox-image.nix) ]; }' > "$WORKDIR/myappdeploy/module.nix"

217```

219```

218

220

219−And deploy:

221+## d) Deploy to VirtualBox target (Linux only)

222+

223+> Deploying requires a Linux host in order to build the Linux binaries.

224+

225+Now we can deploy to the VirtualBox VM.

220

226

221```bash

227```bash

222cd "$WORKDIR/myappdeploy"

228cd "$WORKDIR/myappdeploy"

@@ -243,7 +249,7 @@ It should look like this:

243

249

244Congratulations! You have deployed an Obelisk application to a remote server via SSH.

250Congratulations! You have deployed an Obelisk application to a remote server via SSH.

245

251

246−## d) Deploy an Android app (Linux host only)

252+## e) Deploy an Android app (Linux only)

247

253

248> **Note:** This section requires that you be running a Linux *host*.

254> **Note:** This section requires that you be running a Linux *host*.

249

255

@@ -257,7 +263,7 @@ git commit -m"Accept license"

257git push

263git push

258```

264```

259

265

260−Make sure *USB debugging* is enabled in your Android device ([instructions here](https://developer.android.com/studio/debug/dev-options) and connect the device using USB. Be sure to confirm any security prompts on the device.

266+Make sure *USB debugging* is enabled in your Android device ([instructions here](https://developer.android.com/studio/debug/dev-options)) and connect the device using USB. Be sure to confirm any security prompts on the device.

261

267

262Now update your deployment and deploy to Android:

268Now update your deployment and deploy to Android:

263

269

@@ -267,7 +273,14 @@ ob deploy update

267ob deploy test android -v

273ob deploy test android -v

268```

274```

269

275

276+This deployment will ask you to create a password (at least 6 characters long) and then ask you a series of questions. You can pick arbitrary answers. When you are presented with prompt like:

277+

278+```

279+Is CN=a, OU=b, O=c, L=d, ST=e, C=f correct?

280+ [no]:

281+```

282+

270−This deployment will ask you to create a password (at least 6 characters long) and then ask you a series of questions. You can pick arbitrary answers. If the deployment fails, try using different USB ports on your computer and running `ob deploy test android -v` again. The USB cable you use can also make a difference.

283+You can enter `yes` to continue. If the deployment fails, try using different USB ports on your computer and running `ob deploy test android -v` again. The USB cable you use can also make a difference.

271

284

272When connecting your Android device you may be asked to "Allow USB debugging". You need to allow it.

285When connecting your Android device you may be asked to "Allow USB debugging". You need to allow it.

273![](assets/android-confirm-usb-debugging.jpg)

286![](assets/android-confirm-usb-debugging.jpg)

@@ -279,7 +292,7 @@ When the deployment is complete opening the app should look something like

279

292

280Congratulations! You have deployed an Obelisk Android app via USB.

293Congratulations! You have deployed an Obelisk Android app via USB.

281

294

282−## e) Deploy an iOS app (macOS host only)

295+## f) Deploy an iOS app (Mac only)

283

296

284> **Note:** This section requires that you be running a macOS *host*.

297> **Note:** This section requires that you be running a macOS *host*.

285

298

haskell-overlays/ghcide.nix+38−32

@@ -1,34 +1,40 @@

1self: super:

2− let

2+let

3− pkgs = self.callPackage ({ pkgs }: pkgs) {};

3+ pkgs = self.callPackage ({ pkgs }: pkgs) { };

4− inherit (pkgs.haskell.lib) dontCheck;

4+ inherit (pkgs.haskell.lib) dontCheck justStaticExecutables;

5+ inherit (pkgs.haskellPackages) callHackageDirect callHackage;

6+

5− in {

7+in {

6− ghcide = pkgs.haskell.lib.justStaticExecutables (dontCheck ((self.override {

8+ ghcide = justStaticExecutables (dontCheck (callHackageDirect {

7− overrides = self: super: {

9+ pkg = "ghcide";

10+ ver = "0.2.0";

11+ sha256 = "199l4qzrghhz6wbfkgqdl4gll4wvgpr190kinzhv88idnn9pxm96";

12+ } rec {

8− ghc-check = self.callHackageDirect {

13+ ghc-check = callHackageDirect {

9− pkg = "ghc-check";

14+ pkg = "ghc-check";

10− ver = "0.1.0.3";

15+ ver = "0.3.0.1";

11− sha256 = "038llbvryk5y27jbdpbshp0zw5lw1j6m7qk7vx1n96ykqdzkh649";

16+ sha256 = "1dj909m09m24315x51vxvcl28936ahsw4mavbc53danif3wy09ns";

12− } {};

17+ } { };

13− lsp-test = dontCheck (self.callHackage "lsp-test" "0.6.1.0" {});

18+ lsp-test = dontCheck (callHackage "lsp-test" "0.6.1.0" { });

14− haddock-library = dontCheck (self.callHackage "haddock-library" "1.8.0" {});

19+ haddock-library = dontCheck (callHackage "haddock-library" "1.8.0" { });

15− haskell-lsp = dontCheck (self.callHackage "haskell-lsp" "0.19.0.0" {});

20+ haskell-lsp = dontCheck (callHackageDirect {

21+ pkg = "haskell-lsp";

22+ ver = "0.22.0.0";

23+ sha256 = "1q3w46qcvzraxgmw75s7bl0qvb2fvff242r5vfx95sqska566b4m";

24+ } { inherit haskell-lsp-types; });

16− haskell-lsp-types = dontCheck (self.callHackage "haskell-lsp-types" "0.19.0.0" {});

25+ haskell-lsp-types = dontCheck (callHackageDirect {

17− regex-posix = dontCheck (self.callHackage "regex-posix" "0.96.0.0" {});

26+ pkg = "haskell-lsp-types";

27+ ver = "0.22.0.0";

28+ sha256 = "1apjclphi2v6ggrdnbc0azxbb1gkfj3x1vkwpc8qd6lsrbyaf0n8";

29+ } { });

18− test-framework = dontCheck (self.callHackage "test-framework" "0.8.2.0" {});

30+ regex-tdfa = dontCheck (callHackage "regex-tdfa" "1.3.1.0" {

19− regex-base = dontCheck (self.callHackage "regex-base" "0.94.0.0" {});

31+ regex-base = dontCheck (callHackage "regex-base" "0.94.0.0" { });

20− regex-tdfa = dontCheck (self.callHackage "regex-tdfa" "1.3.1.0" {});

32+ });

21− shake = dontCheck (self.callHackage "shake" "0.18.4" {});

33+ shake = dontCheck (callHackage "shake" "0.18.4" { });

22− hie-bios = dontCheck (self.callHackageDirect {

34+ hie-bios = dontCheck (callHackageDirect {

23− pkg = "hie-bios";

35+ pkg = "hie-bios";

24− ver = "0.4.0";

36+ ver = "0.5.0";

25− sha256 = "19lpg9ymd9656cy17vna8wr1hvzfal94gpm2d3xpnw1d5qr37z7x";

37+ sha256 = "116nmpva5jmlgc2dgy8cm5wv6cinhzmga1l0432p305074w720r2";

26− } {});

38+ } { });

27− };

28− }).callCabal2nix "ghcide" (pkgs.fetchFromGitHub {

29− owner = "digital-asset";

30− repo = "ghcide";

31− rev = "v0.1.0";

32− sha256 = "1kf71iix46hvyxviimrcv7kvsj67hcnnqlpdsmazmlmybf7wbqbb";

33− }) {}));

39+ }));

34}

40}

haskell-overlays/misc-deps.nix+8−2

@@ -9,8 +9,14 @@ let

9in

10

11{

12− hnix = haskellLib.dontCheck (haskellLib.doJailbreak (self.callCabal2nix "hnix" (hackGet ../dep/hnix) {}));

12+ regex-base = self.callHackage "regex-base" "0.94.0.0" {};

13+ regex-posix = self.callHackage "regex-posix" "0.96.0.0" {};

14+ regex-tdfa = self.callHackage "regex-tdfa" "1.3.1.0" {};

15+ test-framework = haskellLib.dontCheck (self.callHackage "test-framework" "0.8.2.0" {});

16+ hnix = haskellLib.dontCheck (self.callHackage "hnix" "0.8.0" {});

13− hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};

17+ hnix-store-core = self.callHackage "hnix-store-core" "0.2.0.0" {};

18+

19+ aeson-gadt-th = self.callHackage "aeson-gadt-th" "0.2.4" {};

14

20

15 ghcid = self.callCabal2nix "ghcid" (hackGet ../dep/ghcid) {};

21 ghcid = self.callCabal2nix "ghcid" (hackGet ../dep/ghcid) {};

16 # Exports more internals

22 # Exports more internals

haskell-overlays/obelisk.nix+5

@@ -19,7 +19,12 @@ in

19 obelisk-command = haskellLib.overrideCabal (self.callCabal2nix "obelisk-command" (obeliskCleanSource ../lib/command) {}) {

20 librarySystemDepends = [

21 pkgs.jre

22+ pkgs.git

22 pkgs.nix

23 pkgs.nix

24+ pkgs.nix-prefetch-git

25+ pkgs.openssh

26+ pkgs.rsync

27+ pkgs.which

23 (haskellLib.justStaticExecutables self.ghcid)

28 (haskellLib.justStaticExecutables self.ghcid)

24 ];

29 ];

25 };

30 };

lib/asset/README.md+16−19

@@ -1,29 +1,26 @@

1−## obelisk-asset

1+# obelisk-asset

2

3−The 'assets.nix' file contains nix expressions that are a mutually

3+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org)

4−recursive set of attributes used to create static asset directories

4+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://github.com/obsidiansystems/obelisk/blob/master/LICENSE)

5−with hashable file encodings. This file should be incorporated within

6−your project's 'default.nix' file. (See ./example/default.nix , line 2)

7−```

8−{assets ? import ./../assets.nix { inherit nixpkgs; }

9−}:

10−```

11

5

12−The 'mkAssets' and 'mkAssetsWith' functions within 'assets.nix' only

6+**Efficiently served, aggressively cached static web resources.**

13−need to be passed an encoding('zopfliEncodings', 'gzipEncodings',

14−'noEncodings') and a static directory of your choice as arguments.

15

7

16−In this example, 'mkAssets' is used on a directory that has a .png

8+The `assets.nix` file contains nix expressions that are a mutually recursive set of attributes used to create static asset directories with hashable file encodings. This file should be incorporated within your project's `default.nix` file. (See `example/default.nix`, line 2)

17−file inside of it. (See ./example/default.nix, line 11)

9+

10+```nix

11+{ assets ? import ./../assets.nix { inherit nixpkgs; } }:

18```

12```

13+

14+The `mkAssets` and `mkAssetsWith` functions within `assets.nix` only need to be passed an `encoding("zopfliEncodings", "gzipEncodings", "noEncodings")` and a static directory of your choice as arguments.

15+

16+In this example, `mkAssets` is used on a directory that has a `.png` file inside of it. (See `example/default.nix`, line 11)

17+

18+```nix

19myAssets = assets.mkAssets ./static;

20```

21

22−Once you have successfully incorporated 'assets.nix' into your

22+Once you have successfully incorporated `assets.nix` into your project's nix file(s), use `nix-build` to generate a symlink of your `mkAssets` expression. The following command from `example/run-example` (line 3) will generate an immutable symlink that holds hashed static assets.

23−project's nix file(s), use nix-build to generate a symlink of

23+

24−your 'mkAssets' expression. The following command from

25−example/run-example (line 3) will generate an immutable symlink

26−that holds hashed static assets.

27```bash

24```bash

28nix-build -o static.assets -A myAssets

25nix-build -o static.assets -A myAssets

29```

26```

lib/asset/assets.nix+28−5

@@ -20,7 +20,7 @@ zopfliEncodings = file:

20 nixpkgs.stdenv.mkDerivation {

21 name = "encodings";

22

23− input = file;

23+ input = mkPath file;

24

25 builder = builtins.toFile "builder.sh" ''

26 source "$stdenv/setup"

@@ -46,7 +46,7 @@ gzipEncodings = file:

46 nixpkgs.stdenv.mkDerivation {

47 name = "encodings";

48

49− input = file;

49+ input = mkPath file;

50

51 builder = builtins.toFile "builder.sh" ''

52 source "$stdenv/setup"

@@ -70,7 +70,7 @@ noEncodings = file:

70 nixpkgs.stdenv.mkDerivation {

71 name = "encodings";

72

73− input = file;

73+ input = mkPath file;

74

75 builder = builtins.toFile "builder.sh" ''

76 source "$stdenv/setup"

@@ -203,7 +203,7 @@ hashFile = path:

203 nixpkgs.nix

204 ];

205 preferLocalBuild = true;

206− inherit path;

206+ path = mkPath path;

207 } ''

208 nix-hash --flat --base32 --type sha256 "$path" | tr -d '\n' >"$out"

209 '');

@@ -224,7 +224,30 @@ symlink = path: {

224 inherit path;

225};

226

227+# Tests if a given character (string of length 1) is valid for a derivation path name.

228+# Passing a string of length other than 1 is undefined.

229+# :: Char -> Bool

230+isValidDrvNameChar = c: "a" <= c && c <= "z" || "A" <= c && c <= "Z" || "0" <= c && c <= "9" || c == "+" || c == "-" || c == "_" || c == "?" || c == "=" || c == ".";

231+

232+# Convert a string into a string that could be used in a derivation name.

233+# replacement lets you choose how to replace invalid characters. It may be any length.

234+# If it contains invalid characters then the result will also be invalid.

235+# :: { str :: String, replacement :: String } -> String

236+mkValidDrvName = { str, replacement ? "?" }:

237+ let

238+ newName = stringAsChars (c: if isValidDrvNameChar c then c else replacement) str;

239+ in if builtins.substring 0 1 newName == "." then "_" + newName else newName;

240+

241+# Like builtins.path but always ensures the name is valid.

242+mkPath = path:

243+ if builtins.typeOf path == "path" # Don't mess with non-paths

244+ then builtins.path {

245+ inherit path;

246+ name = mkValidDrvName { str = builtins.baseNameOf path; };

247+ }

248+ else path;

249+

227−# Given a encoding generation function and a file entry resulting from readDirRecursive in the form { name :: String, value: { path :: String } },

250+# Given an encoding generation function and a file entry resulting from readDirRecursive in the form { name :: String, value: { path :: String } },

228# build a DirEntry for dirToPath with the various encodings of the asset for dirToPath to build into a final directory tree.

251# build a DirEntry for dirToPath with the various encodings of the asset for dirToPath to build into a final directory tree.

229mkAsset = encodings: {name, value}:

252mkAsset = encodings: {name, value}:

230 let nameWithHash = "${hashFile value.path}-${name}";

253 let nameWithHash = "${hashFile value.path}-${name}";

lib/asset/manifest/obelisk-asset-manifest.cabal+4−2

@@ -24,7 +24,7 @@ library

24 , template-haskell

25 , text

26 , transformers

27− , unix

27+ , unix-compat

28 , vector

29 exposed-modules:

30 Obelisk.Asset.Gather

@@ -33,7 +33,9 @@ library

33 Obelisk.Asset.TH

34

35 other-extensions: TemplateHaskell

36+ ghc-options:

37+ -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2

36− ghc-options: -Wall -Werror -fno-warn-unused-do-bind -fwarn-tabs -funbox-strict-fields -O2 -fprof-auto-calls

38+ -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls

37

39

38executable obelisk-asset-manifest-generate

40executable obelisk-asset-manifest-generate

39 hs-source-dirs: src-bin

41 hs-source-dirs: src-bin

lib/asset/manifest/src/Obelisk/Asset/Symlink.hs+1−1

@@ -7,7 +7,7 @@ import Data.Map (Map)

7import qualified Data.Map as Map

8import System.Directory

9import System.FilePath.Posix

10−import System.Posix.Files

10+import System.PosixCompat.Files

11

12-- | Copy the given hashed files from one location to hashed paths in another

13-- location, and symlink the unhashed paths to the hashed ones

lib/asset/serve-snap/obelisk-asset-serve-snap.cabal+4−2

@@ -23,10 +23,12 @@ library

23 , obelisk-snap-extras

24 , text

25 , transformers

26− , unix

26+ , unix-compat

27 exposed-modules:

28 Obelisk.Asset.Accept

29 Obelisk.Asset.Serve.Snap

30

31 other-extensions: TemplateHaskell

32+ ghc-options:

33+ -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O2

32− ghc-options: -Wall -Werror -fno-warn-unused-do-bind -fwarn-tabs -funbox-strict-fields -O2 -fprof-auto-calls

34+ -fno-warn-unused-do-bind -funbox-strict-fields -fprof-auto-calls

lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+1−1

@@ -31,7 +31,7 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)

31import System.Directory (getDirectoryContents)

32import System.FilePath ((</>), splitFileName, takeDirectory)

33import System.IO.Error (isDoesNotExistError)

34−import System.Posix (getFileStatus, fileSize)

34+import System.PosixCompat.Files (getFileStatus, fileSize)

35

36-- | Serve static assets from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.

37--

lib/backend/obelisk-backend.cabal+2−2

@@ -21,10 +21,10 @@ library

21 obelisk-frontend,

22 obelisk-route,

23 obelisk-snap-extras,

24− reflex-dom,

24+ reflex-dom-core,

25 snap,

26 snap-server,

27 text,

28 universe

29 exposed-modules: Obelisk.Backend

30− ghc-options: -Wall

30+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/backend/src/Obelisk/Backend.hs+1−1

@@ -58,7 +58,7 @@ import qualified Obelisk.ExecutableConfig.Lookup as Lookup

58import Obelisk.Frontend

59import Obelisk.Route

60import Obelisk.Snap.Extras (doNotCache, serveFileIfExistsAs)

61−import Reflex.Dom

61+import Reflex.Dom.Core

62import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, modifyResponse

63 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText

64 , rqCookies, Cookie(..) , setHeader)

lib/cliapp/obelisk-cliapp.cabal+3−1

@@ -19,10 +19,12 @@ library

19 , monad-loops

20 , mtl

21 , process

22+ , shell-escape

22 , terminal-size

23 , terminal-size

23 , text

24 , text

24 , time

25 , time

25 , transformers

26 , transformers

27+ , utf8-string

26 exposed-modules:

28 exposed-modules:

27 Obelisk.CliApp

29 Obelisk.CliApp

28 other-modules:

30 other-modules:

@@ -32,4 +34,4 @@ library

32 Obelisk.CliApp.TerminalString

34 Obelisk.CliApp.TerminalString

33 Obelisk.CliApp.Theme

35 Obelisk.CliApp.Theme

34 Obelisk.CliApp.Types

36 Obelisk.CliApp.Types

35− ghc-options: -Wall -fobject-code

37+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/cliapp/src/Obelisk/CliApp.hs+3

@@ -39,7 +39,9 @@ module Obelisk.CliApp

39 , callCommand

40 , callProcess

41 , callProcessAndLogOutput

42+ , createProcess

42 , createProcess_

43 , createProcess_

44+ , exitCodeToException

43 , overCreateProcess

45 , overCreateProcess

44 , proc

46 , proc

45 , readCreateProcessWithExitCode

47 , readCreateProcessWithExitCode

@@ -47,6 +49,7 @@ module Obelisk.CliApp

47 , readProcessAndLogStderr

49 , readProcessAndLogStderr

48 , readProcessJSONAndLogStderr

50 , readProcessJSONAndLogStderr

49 , reconstructCommand

51 , reconstructCommand

52+ , runProcess_

50 , setCwd

53 , setCwd

51 , setDelegateCtlc

54 , setDelegateCtlc

52 , setEnvOverride

55 , setEnvOverride

lib/cliapp/src/Obelisk/CliApp/Logging.hs+2−2

@@ -160,7 +160,7 @@ failWith :: (CliThrow e m, AsUnstructuredError e) => Text -> m a

160failWith = throwError . review asUnstructuredError

161

162errorToWarning

163− :: (HasCliConfig e m, CliThrow e m, CliLog m)

163+ :: (HasCliConfig e m, CliLog m)

164 => e -> m ()

165errorToWarning e = do

166 c <- getCliConfig

@@ -177,7 +177,7 @@ withExitFailMessage msg f = f `catch` \(e :: ExitCode) -> do

177 throwM e

178

179-- | Write log to stdout, with colors (unless `noColor`)

180−writeLog :: (MonadIO m, MonadMask m) => Bool -> Bool -> WithSeverity Text -> m ()

180+writeLog :: (MonadIO m) => Bool -> Bool -> WithSeverity Text -> m ()

181writeLog withNewLine noColor (WithSeverity severity s) = if T.null s then pure () else write

182 where

183 write

lib/cliapp/src/Obelisk/CliApp/Process.hs+48−29

@@ -1,7 +1,6 @@

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE MultiWayIf #-}

5{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TupleSections #-}

6{-# LANGUAGE TupleSections #-}

@@ -17,6 +16,7 @@ module Obelisk.CliApp.Process

17 , callProcessAndLogOutput

16 , callProcessAndLogOutput

18 , createProcess

17 , createProcess

19 , createProcess_

18 , createProcess_

19+ , exitCodeToException

20 , overCreateProcess

21 , proc

22 , readCreateProcessWithExitCode

@@ -24,6 +24,7 @@ module Obelisk.CliApp.Process

24 , readProcessAndLogStderr

25 , readProcessJSONAndLogStderr

26 , reconstructCommand

27+ , runProcess_

27 , setCwd

28 , setCwd

28 , setDelegateCtlc

29 , setDelegateCtlc

29 , setEnvOverride

30 , setEnvOverride

@@ -32,12 +33,14 @@ module Obelisk.CliApp.Process

32 ) where

33 ) where

33

34

34import Control.Monad ((<=<), join, void)

35import Control.Monad ((<=<), join, void)

36+import Control.Monad.Catch (MonadMask, bracketOnError)

35import Control.Monad.Except (throwError)

37import Control.Monad.Except (throwError)

36import Control.Monad.Fail

38import Control.Monad.Fail

37import Control.Monad.IO.Class (MonadIO, liftIO)

39import Control.Monad.IO.Class (MonadIO, liftIO)

38import Control.Lens (Prism', review)

40import Control.Lens (Prism', review)

39import qualified Data.ByteString as BS

41import qualified Data.ByteString as BS

40import qualified Data.ByteString.Char8 as BSC

42import qualified Data.ByteString.Char8 as BSC

43+import qualified Data.ByteString.UTF8 as BSU

41import Data.Function (fix)

44import Data.Function (fix)

42import Data.Map (Map)

45import Data.Map (Map)

43import qualified Data.Map as Map

46import qualified Data.Map as Map

@@ -54,6 +57,7 @@ import qualified System.IO.Streams as Streams

54import System.IO.Streams.Concurrent (concurrentMerge)

57import System.IO.Streams.Concurrent (concurrentMerge)

55import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out)

58import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out)

56import qualified System.Process as Process

59import qualified System.Process as Process

60+import Text.ShellEscape (bash, bytes)

57import qualified Data.Aeson as Aeson

61import qualified Data.Aeson as Aeson

58

62

59import Control.Monad.Log (Severity (..))

63import Control.Monad.Log (Severity (..))

@@ -97,7 +101,7 @@ instance AsProcessFailure ProcessFailure where

97 asProcessFailure = id

101 asProcessFailure = id

98

102

99readProcessAndLogStderr

103readProcessAndLogStderr

100− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

104+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

101 => Severity -> ProcessSpec -> m Text

105 => Severity -> ProcessSpec -> m Text

102readProcessAndLogStderr sev process = do

106readProcessAndLogStderr sev process = do

103 (out, _err) <- withProcess process $ \_out err -> do

107 (out, _err) <- withProcess process $ \_out err -> do

@@ -105,7 +109,7 @@ readProcessAndLogStderr sev process = do

105 liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

109 liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

106

110

107readProcessJSONAndLogStderr

111readProcessJSONAndLogStderr

108− :: (Aeson.FromJSON a, MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

112+ :: (Aeson.FromJSON a, MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

109 => Severity -> ProcessSpec -> m a

113 => Severity -> ProcessSpec -> m a

110readProcessJSONAndLogStderr sev process = do

114readProcessJSONAndLogStderr sev process = do

111 (out, _err) <- withProcess process $ \_out err -> do

115 (out, _err) <- withProcess process $ \_out err -> do

@@ -118,7 +122,7 @@ readProcessJSONAndLogStderr sev process = do

118 throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) 0

122 throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) 0

119

123

120readCreateProcessWithExitCode

124readCreateProcessWithExitCode

121− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

125+ :: (MonadIO m, CliLog m)

122 => ProcessSpec -> m (ExitCode, String, String)

126 => ProcessSpec -> m (ExitCode, String, String)

123readCreateProcessWithExitCode procSpec = do

127readCreateProcessWithExitCode procSpec = do

124 process <- mkCreateProcess procSpec

128 process <- mkCreateProcess procSpec

@@ -128,10 +132,10 @@ readCreateProcessWithExitCode procSpec = do

128-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

132-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

129-- with the corresponding severity.

133-- with the corresponding severity.

130--

134--

131−-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

135+-- Usually this function is called as `readProcessAndLogOutput (Debug, Error)`. However

132-- some processes are known to spit out diagnostic or informative messages in stderr, in

136-- some processes are known to spit out diagnostic or informative messages in stderr, in

133-- which case it is advisable to call it with a non-Error severity for stderr, like

137-- which case it is advisable to call it with a non-Error severity for stderr, like

134−-- `callProcessAndLogOutput (Debug, Debug)`.

138+-- `readProcessAndLogOutput (Debug, Debug)`.

135readProcessAndLogOutput

139readProcessAndLogOutput

136 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

140 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

137 => (Severity, Severity) -> ProcessSpec -> m Text

141 => (Severity, Severity) -> ProcessSpec -> m Text

@@ -144,9 +148,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

144 outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

148 outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

145 putLogRaw sev_out outText

149 putLogRaw sev_out outText

146

150

147− waitForProcess p >>= \case

151+ outText <$ (exitCodeToException process =<< waitForProcess p)

148− ExitSuccess -> pure outText

149− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

150

152

151-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

153-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

152-- with the corresponding severity.

154-- with the corresponding severity.

@@ -156,7 +158,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

156-- which case it is advisable to call it with a non-Error severity for stderr, like

158-- which case it is advisable to call it with a non-Error severity for stderr, like

157-- `callProcessAndLogOutput (Debug, Debug)`.

159-- `callProcessAndLogOutput (Debug, Debug)`.

158callProcessAndLogOutput

160callProcessAndLogOutput

159− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

161+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

160 => (Severity, Severity) -> ProcessSpec -> m ()

162 => (Severity, Severity) -> ProcessSpec -> m ()

161callProcessAndLogOutput (sev_out, sev_err) process =

163callProcessAndLogOutput (sev_out, sev_err) process =

162 void $ withProcess process $ \out err -> do

164 void $ withProcess process $ \out err -> do

@@ -186,12 +188,11 @@ createProcess_ name procSpec = do

186 liftIO $ Process.createProcess_ name p

188 liftIO $ Process.createProcess_ name p

187

189

188mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

190mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

189−mkCreateProcess (ProcessSpec p override') = do

191+mkCreateProcess (ProcessSpec p override') = case override' of

190− case override' of

191− Nothing -> pure p

192+ Nothing -> pure p

192− Just override -> do

193+ Just override -> do

193− procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

194+ procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

194− pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

195+ pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

195

196

196-- | Like `System.Process.callProcess` but also logs (debug) the process being run

197-- | Like `System.Process.callProcess` but also logs (debug) the process being run

197callProcess

198callProcess

@@ -210,18 +211,30 @@ callCommand cmd = do

210 liftIO $ Process.callCommand cmd

211 liftIO $ Process.callCommand cmd

211

212

212withProcess

213withProcess

213− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

214+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

214 => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

215 => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

215−withProcess process f = do -- TODO: Use bracket.

216+withProcess process f =

216− -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

217+ bracketOnError

217− (_, Just out, Just err, p) <- createProcess $ overCreateProcess

218+ (createProcess $ overCreateProcess

218− (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

219+ (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

219−

220+ )

220− f out err -- Pass the handles to the passed function

221+ (liftIO . Process.cleanupProcess)

221−

222+ (\case

222− waitForProcess p >>= \case

223+ (_, Just out, Just err, p) -> do

223− ExitSuccess -> return (out, err)

224+ f out err

224− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

225+ (out, err) <$ (exitCodeToException process =<< waitForProcess p)

226+ _ -> error "withProcess: createProcess did not provide handles for CreatePipe as expected"

227+ )

228+

229+-- | Runs a process to completion failing if it does not exit cleanly.

230+runProcess_

231+ :: (MonadIO m, CliLog m, CliThrow e m, MonadMask m, AsProcessFailure e)

232+ => ProcessSpec -> m ()

233+runProcess_ process =

234+ bracketOnError

235+ (createProcess process)

236+ (liftIO . Process.cleanupProcess)

237+ (\(_, _, _, ph) -> exitCodeToException process =<< waitForProcess ph)

225

238

226-- Create an input stream from the file handle, associating each item with the given severity.

239-- Create an input stream from the file handle, associating each item with the given severity.

227streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

240streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

@@ -240,14 +253,20 @@ streamToLog stream = fix $ \loop -> do

240waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode

253waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode

241waitForProcess = liftIO . Process.waitForProcess

254waitForProcess = liftIO . Process.waitForProcess

242

255

256+-- | Converts an 'ExitCode' to an exception when it's non-zero.

257+exitCodeToException :: (CliThrow e m, AsProcessFailure e) => ProcessSpec -> ExitCode -> m ()

258+exitCodeToException spec = \case

259+ ExitSuccess -> pure ()

260+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess spec) code

261+

243-- | Pretty print a 'CmdSpec'

262-- | Pretty print a 'CmdSpec'

244reconstructCommand :: Process.CmdSpec -> Text

263reconstructCommand :: Process.CmdSpec -> Text

245reconstructCommand p = case p of

264reconstructCommand p = case p of

246 Process.ShellCommand str -> T.pack str

265 Process.ShellCommand str -> T.pack str

247 Process.RawCommand c as -> processToShellString c as

266 Process.RawCommand c as -> processToShellString c as

248 where

267 where

249− processToShellString cmd args = T.unwords $ map quoteAndEscape (cmd : args)

268+ processToShellString cmd args = T.pack $ unwords $

250− quoteAndEscape x = "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

269+ map (BSU.toString . bytes . bash . BSU.fromString) (cmd : args)

251

270

252reconstructProcSpec :: ProcessSpec -> Text

271reconstructProcSpec :: ProcessSpec -> Text

253reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

272reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

lib/command/obelisk-command.cabal+5−3

@@ -1,5 +1,5 @@

1name: obelisk-command

2−version: 0.7.0.1

2+version: 0.9.0.1

3cabal-version: >= 1.8

4build-type: Simple

5

@@ -39,13 +39,15 @@ library

39 , optparse-applicative

40 , placeholders

41 , process

42+ , shell-escape

42 , temporary

43 , temporary

43 , terminal-size

44 , terminal-size

44 , text

45 , text

45 , time

46 , time

46 , transformers

47 , transformers

47− , unix

48+ , unix-compat

48 , unordered-containers

49 , unordered-containers

50+ , utf8-string

49 , which

51 , which

50 , yaml

52 , yaml

51 exposed-modules:

53 exposed-modules:

@@ -64,4 +66,4 @@ library

64executable ob

66executable ob

65 main-is: src-bin/ob.hs

67 main-is: src-bin/ob.hs

66 build-depends: base, obelisk-command

68 build-depends: base, obelisk-command

67− ghc-options: -Wall -O2 -threaded

69+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -threaded

lib/command/src/Obelisk/Command.hs+23−16

@@ -22,7 +22,7 @@ import System.Environment

22import System.FilePath

23import qualified System.Info

24import System.IO (hIsTerminalDevice, stdout)

25−import System.Posix.Process (executeFile)

25+import System.Process (rawSystem)

26

27import Obelisk.App

28import Obelisk.CliApp

@@ -74,8 +74,8 @@ argsInfo cfg = info (args cfg <**> helper) $ mconcat

74initSource :: Parser InitSource

75initSource = foldl1 (<|>)

76 [ pure InitSource_Default

77− , InitSource_Branch <$> strOption (long "branch" <> metavar "BRANCH")

77+ , InitSource_Branch <$> strOption (long "branch" <> metavar "BRANCH" <> help "Initialize the project using the given BRANCH of Obelisk's official repository")

78− , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH")

78+ , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH" <> help "(Use with caution) Initialize the project using the copy of Obelisk found at the given PATH")

79 ]

80

81initForce :: Parser Bool

@@ -99,7 +99,9 @@ data ObInternal

99 -- the preprocessor argument syntax is also handled outside

100 -- optparse-applicative, but it shouldn't ever conflict with another syntax

101 = ObInternal_ApplyPackages String String String [String]

102− | ObInternal_ExportGhciConfig [(FilePath, Interpret)]

102+ | ObInternal_ExportGhciConfig

103+ [(FilePath, Interpret)]

104+ Bool -- ^ Use relative paths

103 deriving Show

105 deriving Show

104

106

105obCommand :: ArgsConfig -> Parser ObCommand

107obCommand :: ArgsConfig -> Parser ObCommand

@@ -112,7 +114,7 @@ obCommand cfg = hsubparser

112 , command "thunk" $ info (ObCommand_Thunk <$> thunkOption) $ progDesc "Manipulate thunk directories"

114 , command "thunk" $ info (ObCommand_Thunk <$> thunkOption) $ progDesc "Manipulate thunk directories"

113 , command "repl" $ info (ObCommand_Repl <$> interpretOpts) $ progDesc "Open an interactive interpreter"

115 , command "repl" $ info (ObCommand_Repl <$> interpretOpts) $ progDesc "Open an interactive interpreter"

114 , command "watch" $ info (ObCommand_Watch <$> interpretOpts) $ progDesc "Watch current project for errors and warnings"

116 , command "watch" $ info (ObCommand_Watch <$> interpretOpts) $ progDesc "Watch current project for errors and warnings"

115− , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"

117+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies or run a command in such a shell. E.g. ob shell -- ghc-pkg list"

116 , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

118 , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

117 progDesc "List paths to haddock documentation for specified packages"

119 progDesc "List paths to haddock documentation for specified packages"

118 <> footerDoc (Just $

120 <> footerDoc (Just $

@@ -124,8 +126,11 @@ obCommand cfg = hsubparser

124

126

125internalCommand :: Parser ObInternal

127internalCommand :: Parser ObInternal

126internalCommand = hsubparser $ mconcat

128internalCommand = hsubparser $ mconcat

129+ [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts <*> useRelativePathsFlag)

127− [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts) $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

130+ $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

128 ]

131 ]

132+ where

133+ useRelativePathsFlag = switch (long "use-relative-paths" <> help "Use relative paths")

129

134

130packageNames :: Parser [String]

135packageNames :: Parser [String]

131packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

136packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

@@ -225,7 +230,6 @@ data ThunkCommand

225 = ThunkCommand_Update ThunkUpdateConfig

230 = ThunkCommand_Update ThunkUpdateConfig

226 | ThunkCommand_Unpack

231 | ThunkCommand_Unpack

227 | ThunkCommand_Pack ThunkPackConfig

232 | ThunkCommand_Pack ThunkPackConfig

228− | ThunkCommand_Init

229 deriving Show

233 deriving Show

230

234

231thunkOption :: Parser ThunkOption

235thunkOption :: Parser ThunkOption

@@ -233,7 +237,6 @@ thunkOption = hsubparser $ mconcat

233 [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"

237 [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"

234 , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"

238 , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"

235 , command "pack" $ info (thunkOptionWith $ ThunkCommand_Pack <$> thunkPackConfig) $ progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"

239 , command "pack" $ info (thunkOptionWith $ ThunkCommand_Pack <$> thunkPackConfig) $ progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"

236− , command "init" $ info (thunkOptionWith $ pure ThunkCommand_Init) $ progDesc "Initialize git checkout by converting it to an unpacked thunk"

237 ]

240 ]

238 where

241 where

239 thunkOptionWith f = ThunkOption

242 thunkOptionWith f = ThunkOption

@@ -282,7 +285,10 @@ shellOpts :: Parser ShellOpts

282shellOpts = ShellOpts

285shellOpts = ShellOpts

283 <$> shellFlags

286 <$> shellFlags

284 <*> interpretOpts

287 <*> interpretOpts

288+ -- This funny construction is used to support optparse-applicative's @--@ parsing.

289+ -- All arguments after @--@ are left unparsed and instead provided to the last positional parser

290+ -- which must therefore be 'many' in order to consume the rest of the input.

285− <*> optional (strArgument (metavar "COMMAND"))

291+ <*> ((\xs -> if null xs then Nothing else Just $ unwords xs) <$> many (strArgument (metavar "COMMAND")))

286

292

287portOpt :: Int -> Parser Int

293portOpt :: Int -> Parser Int

288portOpt dfault = option auto (long "port" <> short 'p' <> help "Port number for server" <> showDefault <> value dfault <> metavar "INT")

294portOpt dfault = option auto (long "port" <> short 'p' <> help "Port number for server" <> showDefault <> value dfault <> metavar "INT")

@@ -360,7 +366,8 @@ main' argsCfg = do

360 Just impl -> do

366 Just impl -> do

361 -- Invoke the real implementation, using --no-handoff to prevent infinite recursion

367 -- Invoke the real implementation, using --no-handoff to prevent infinite recursion

362 putLog Debug $ "Handing off to " <> T.pack impl

368 putLog Debug $ "Handing off to " <> T.pack impl

363− liftIO $ executeFile impl False ("--no-handoff" : myArgs) Nothing

369+ _ <- liftIO $ rawSystem impl ("--no-handoff" : myArgs)

370+ return ()

364 case myArgs of

371 case myArgs of

365 "--no-handoff" : as -> go as -- If we've been told not to hand off, don't hand off

372 "--no-handoff" : as -> go as -- If we've been told not to hand off, don't hand off

366 origPath:inPath:outPath:preprocessorName:packagePaths

373 origPath:inPath:outPath:preprocessorName:packagePaths

@@ -390,21 +397,21 @@ ob = \case

390 ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)

397 ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)

391 ThunkCommand_Unpack -> for_ thunks unpackThunk

398 ThunkCommand_Unpack -> for_ thunks unpackThunk

392 ThunkCommand_Pack config -> for_ thunks (packThunk config)

399 ThunkCommand_Pack config -> for_ thunks (packThunk config)

393− ThunkCommand_Init -> for_ thunks initThunk

394 where

400 where

395 thunks = _thunkOption_thunks to

401 thunks = _thunkOption_thunks to

396 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

402 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

397 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

403 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

398 ObCommand_Shell (ShellOpts shellAttr interpretPathsList cmd) -> withInterpretPaths interpretPathsList $ \root interpretPaths ->

404 ObCommand_Shell (ShellOpts shellAttr interpretPathsList cmd) -> withInterpretPaths interpretPathsList $ \root interpretPaths ->

399− nixShellForInterpretPaths False shellAttr root interpretPaths cmd

405+ nixShellForInterpretPaths False shellAttr root interpretPaths cmd -- N.B. We do NOT bash escape here; we want to run the command as-is

400− ObCommand_Doc shellAttr pkgs -> withProjectRoot "." $ \root ->

406+ ObCommand_Doc shellAttr pkgs -> withInterpretPaths [] $ \root interpretPaths ->

401− nixShellForInterpretPaths True shellAttr root emptyPathTree $ Just $ haddockCommand pkgs

407+ nixShellForInterpretPaths True shellAttr root interpretPaths $ Just $ haddockCommand pkgs

402 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

408 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

403− nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"

409+ nixShellWithHoogle root True shell' $ Just $ "hoogle server -p" <> show port <> " --local"

404 ObCommand_Internal icmd -> case icmd of

410 ObCommand_Internal icmd -> case icmd of

405 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

411 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

406 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

412 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

413+ ObInternal_ExportGhciConfig interpretPathsList useRelativePaths ->

407− ObInternal_ExportGhciConfig interpretPathsList -> liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList exportGhciConfig

414+ liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList (exportGhciConfig useRelativePaths)

408

415

409-- | A helper for the common case that the command you want to run needs the project root and a resolved

416-- | A helper for the common case that the command you want to run needs the project root and a resolved

410-- set of interpret paths.

417-- set of interpret paths.

lib/command/src/Obelisk/Command/Deploy.hs+16−16

@@ -25,7 +25,7 @@ import GHC.Generics

25import System.Directory

26import System.FilePath

27import System.IO

28−import System.Posix.Files

28+import System.PosixCompat.Files

29import Text.URI (URI)

30import qualified Text.URI as URI

31import Text.URI.Lens

@@ -85,13 +85,12 @@ deployInit' thunkPtr (DeployInitOpts deployDir sshKeyPath hostnames route adminE

85 --accidentally create a production deployment that uses development

86 --credentials to connect to some resources. This could result in, e.g.,

87 --production data backed up to a dev environment.

88− withSpinner "Creating project configuration directories" $ do

88+ withSpinner "Creating project configuration directories" $ liftIO $ do

89− callProcessAndLogOutput (Notice, Error) $

89+ mapM_ (createDirectoryIfMissing True)

90− proc "mkdir" [ "-p"

91− , deployDir </> "config" </> "backend"

90+ [ deployDir </> "config" </> "backend"

92− , deployDir </> "config" </> "common"

91+ , deployDir </> "config" </> "common"

93− , deployDir </> "config" </> "frontend"

92+ , deployDir </> "config" </> "frontend"

94− ]

93+ ]

95

94

96 let srcDir = deployDir </> "src"

95 let srcDir = deployDir </> "src"

97 withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ do

96 withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ do

@@ -162,8 +161,8 @@ deployPush deployPath getNixBuilders = do

162 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]

161 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]

163 withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

162 withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

164 callProcessAndLogOutput (Notice, Warning) $

163 callProcessAndLogOutput (Notice, Warning) $

165− proc "rsync"

164+ proc rsyncPath

166− [ "-e ssh " <> unwords sshOpts

165+ [ "-e " <> sshPath <> " " <> unwords sshOpts

167 , "-qarvz"

166 , "-qarvz"

168 , deployPath </> "config"

167 , deployPath </> "config"

169 , "root@" <> host <> ":/var/lib/backend"

168 , "root@" <> host <> ":/var/lib/backend"

@@ -171,9 +170,10 @@ deployPush deployPath getNixBuilders = do

171 --TODO: Create GC root so we're sure our closure won't go away during this time period

170 --TODO: Create GC root so we're sure our closure won't go away during this time period

172 withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

171 withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

173 callProcessAndLogOutput (Notice, Warning) $

172 callProcessAndLogOutput (Notice, Warning) $

174− proc "ssh" $ sshOpts <>

173+ proc sshPath $ sshOpts <>

175 [ "root@" <> host

174 [ "root@" <> host

176 , unwords

175 , unwords

176+ -- Note that we don't want to $(staticWhich "nix-env") here, because this is executing on a remote machine

177 [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath

178 , "&&"

179 , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"

@@ -182,10 +182,10 @@ deployPush deployPath getNixBuilders = do

182 isClean <- checkGitCleanStatus deployPath True

183 when (not isClean) $ do

184 withSpinner "Committing changes to Git" $ do

185− callProcessAndLogOutput (Debug, Error) $ proc "git"

185+ callProcessAndLogOutput (Debug, Error) $

186− ["-C", deployPath, "add", "."]

186+ gitProc deployPath ["add", "."]

187− callProcessAndLogOutput (Debug, Error) $ proc "git"

187+ callProcessAndLogOutput (Debug, Error) $

188− ["-C", deployPath, "commit", "-m", "New deployment"]

188+ gitProc deployPath ["commit", "-m", "New deployment"]

189 putLog Notice $ "Deployed => " <> T.pack route

190 where

191 callProcess' envMap cmd args = do

@@ -315,7 +315,7 @@ readDeployConfig deployDir fname = liftIO $ do

315

316verifyHostKey :: MonadObelisk m => FilePath -> FilePath -> String -> m ()

317verifyHostKey knownHostsPath keyPath hostName =

318− callProcessAndLogOutput (Notice, Warning) $ proc "ssh" $

318+ callProcessAndLogOutput (Notice, Warning) $ proc sshPath $

319 sshArgs knownHostsPath keyPath True <>

320 [ "root@" <> hostName

321 , "-o", "NumberOfPasswordPrompts=0"

lib/command/src/Obelisk/Command/Nix.hs+4−4

@@ -207,7 +207,7 @@ nixCmdProc' cmdCfg = (proc (T.unpack cmd) options, cmd)

207 )

208

209nixCmd :: MonadObelisk m => NixCmd -> m FilePath

210−nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built " <> desc) $ do

210+nixCmd cmdCfg = withSpinner' (T.unwords $ "Running" : cmd : desc) (Just $ const $ T.unwords $ "Built" : desc) $ do

211 output <- readProcessAndLogStderr Debug cmdProc

212 -- Remove final newline that Nix appends

213 Just (outPath, '\n') <- pure $ T.unsnoc output

@@ -218,7 +218,7 @@ nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built

218 NixCmd_Build cfg' -> cfg' ^. nixCommonConfig

219 NixCmd_Instantiate cfg' -> cfg' ^. nixCommonConfig

220 path = commonCfg ^. nixCmdConfig_target . target_path

221− desc = T.pack $ mconcat $ catMaybes

221+ desc = concat $ catMaybes

222− [ ("on " <>) <$> path

222+ [ (\x -> ["on", T.pack x]) <$> path

223− , (\a -> " [" <> a <> "]") <$> (commonCfg ^. nixCmdConfig_target . target_attr)

223+ , (\a -> ["[" <> T.pack a <> "]"]) <$> (commonCfg ^. nixCmdConfig_target . target_attr)

224 ]

lib/command/src/Obelisk/Command/Preprocessor.hs+62−58

@@ -5,92 +5,96 @@ module Obelisk.Command.Preprocessor where

5

6import qualified Data.ByteString.Lazy as BL

7import qualified Data.ByteString.Lazy.Builder as BU

8+import Data.Foldable (for_)

8import Data.List (intersperse, isPrefixOf, sortOn)

9import Data.List (intersperse, isPrefixOf, sortOn)

9import Data.Maybe (fromMaybe)

10import Data.Maybe (fromMaybe)

10import qualified Data.Text.Lazy.Builder as TL

11import qualified Data.Text.Lazy.Builder as TL

11import qualified Data.Text.Lazy.Encoding as TL

12import qualified Data.Text.Lazy.Encoding as TL

12import Distribution.Compiler (CompilerFlavor (..))

13import Distribution.Compiler (CompilerFlavor (..))

13import Language.Haskell.Extension (Extension (..), Language(..))

14import Language.Haskell.Extension (Extension (..), Language(..))

15+import System.Directory (canonicalizePath)

14−import System.IO (IOMode (..), hClose, hPutStrLn, openFile, stderr)

16+import System.IO (IOMode (..), hPutStrLn, stderr, withFile)

15−import System.FilePath (hasTrailingPathSeparator, joinPath, normalise, splitPath)

17+import System.FilePath (hasTrailingPathSeparator, joinPath, splitPath)

16

18

17import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage')

19import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage')

18

20

21+-- | This code is intended to be executed via ghci's -pgmF preprocessor option.

22+-- The command line arguments are passed in via ghc, which dictates the first three options and meanings

23+-- In order for this code to execute, origPath must contain either a '.' character or a '/' character.

24+-- (This is to avoid the possibility of the command line syntax conflicting with another ob command)

25+-- We do have control over the remaining arguments, but they must be the same for all files.

26+-- Thus, the fourth command line argument must be "apply-packages", which has already been handled.

27+-- We assume all the remaining arguments passed in are paths to cabal or hpack package specifications.

28+-- Thus we must select among the packagePaths for the file we are going to parse.

19applyPackages :: FilePath -> FilePath -> FilePath -> [FilePath] -> IO ()

29applyPackages :: FilePath -> FilePath -> FilePath -> [FilePath] -> IO ()

20−applyPackages origPath inPath outPath packagePaths = do

30+applyPackages origPath inPath outPath packagePaths' = do

21− -- This code is intended to be executed via ghci's -pgmF preprocessor option

31+ origPathCanonical <- canonicalizePath origPath

22− -- The command line arguments are passed in via ghc, which dictates the first three options and meanings

32+ packagePaths <- traverse canonicalizePath packagePaths'

23− -- In order for this code to execute, origPath must contain either a '.' character or a '/' character.

24− -- (This is to avoid the possibility of the command line syntax conflicting with another ob command)

25− -- We do have control over the remaining arguments, but they must be the same for all files.

26− -- Thus, the fourth command line argument must be "apply-packages", which has already been handled.

27− -- We assume all the remaining arguments passed in are paths to cabal or hpack package specifications.

28

33

29− outFile <- openFile outPath WriteMode

34+ let

30− let hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText

35+ takeDirs = takeWhile hasTrailingPathSeparator

36+ packageDirs = sortOn (negate . length . takeDirs) $ map splitPath packagePaths

37+ origDir = splitPath origPathCanonical

38+ matches = [ joinPath d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]

31

39

32− -- putStr "--------------------------------------------------------------------------------\n"

33− -- print args

34− -- putStr "--------------------------------------------------------------------------------\n"

35−

36− -- Thus we must select among the packagePaths for the file we are going to parse.

37−

38− let takeDirs = takeWhile hasTrailingPathSeparator

39− packageDirs = sortOn (negate . length . takeDirs) $ map (splitPath . normalise) packagePaths

40− origDir = splitPath $ normalise origPath

41− matches = [ joinPath d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]

42−

43− -- So the first element of matches is going to be the deepest path to a package spec that contains

40+ -- The first element of matches is going to be the deepest path to a package spec that contains

44 -- our file as a subdirectory.

41 -- our file as a subdirectory.

45−

46− case matches of

42+ packageInfo' <- case matches of

47− [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning

43+ [] -> do

48− (packagePath:_) -> do

44+ hPutStrLn stderr $ "Error: Unable to find cabal information for " <> origPath <> "; Skipping preprocessor."

45+ pure Nothing

49− parseCabalPackage' packagePath >>= \case

46+ packagePath:_ -> parseCabalPackage' packagePath >>= \case

50− Left err ->

47+ Left err -> do

51− hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error was " <> show err

48+ hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error: " <> show err

49+ pure Nothing

52− Right (_warnings, packageInfo) ->

50+ Right (Just (_, packageInfo)) -> pure $ Just packageInfo

51+ Right Nothing -> pure Nothing

52+

53+ writeOutput packageInfo' inPath outPath

54+

55+writeOutput :: Maybe CabalPackageInfo -> FilePath -> FilePath -> IO ()

56+writeOutput packageInfo' origPath outPath = withFile outPath WriteMode $ \hOut -> do

53− hPutTextBuilder outFile (generateHeader origPath packageInfo)

57+ for_ packageInfo' $ \packageInfo -> hPutTextBuilder hOut (generateHeader origPath packageInfo)

54−

55− BL.readFile inPath >>= BL.hPut outFile

58+ BL.readFile origPath >>= BL.hPut hOut

56− hClose outFile

59+ where

57−

60+ hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText

58−

59− -- I'm pretty sure there's a certain amount of oversimplification in CabalPackageInfo, so I doubt this is fully robust.

60

61

61generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

62generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

62generateHeader origPath packageInfo =

63generateHeader origPath packageInfo =

63 hsExtensions <> ghcOptions <> lineNumberPragma origPath

64 hsExtensions <> ghcOptions <> lineNumberPragma origPath

64 where

65 where

65 hsExtensions =

66 hsExtensions =

66− if not (null extList)

67+ if null extList

67− then TL.fromText "{-# LANGUAGE "

68+ then mempty

68− <> mconcat (intersperse (TL.fromText ", ") extList)

69+ else pragma $ TL.fromText "LANGUAGE " <> mconcat (intersperse (TL.fromText ", ") extList)

69− <> TL.fromText " #-}\n"

70− else mempty

71 extList = addDefaultLanguage $ concatMap showExt $ _cabalPackageInfo_defaultExtensions packageInfo

70 extList = addDefaultLanguage $ concatMap showExt $ _cabalPackageInfo_defaultExtensions packageInfo

72 addDefaultLanguage =

71 addDefaultLanguage =

73 case _cabalPackageInfo_defaultLanguage packageInfo of

72 case _cabalPackageInfo_defaultLanguage packageInfo of

74 Nothing -> id

73 Nothing -> id

75 Just x -> case x of

74 Just x -> case x of

76− UnknownLanguage ext -> ( TL.fromString ext :)

75+ UnknownLanguage ext -> (TL.fromString ext :)

77− ext -> ( TL.fromString (show ext) :)

76+ ext -> (TL.fromString (show ext) :)

78 showExt = \case

77 showExt = \case

79 EnableExtension ext -> [TL.fromString (show ext)]

78 EnableExtension ext -> [TL.fromString (show ext)]

80− DisableExtension _ -> []

79+ DisableExtension ext -> ["No" <> TL.fromString (show ext)]

81 UnknownExtension ext -> [TL.fromString ext]

80 UnknownExtension ext -> [TL.fromString ext]

82

81

83 ghcOptions =

82 ghcOptions =

84− if not (null optList)

83+ if null optList

85− then TL.fromText "{-# OPTIONS_GHC "

84+ then mempty

85+ else pragma $

86− <> mconcat (intersperse (TL.fromText " ") optList)

86+ TL.fromText "OPTIONS_GHC " <> mconcat (intersperse (TL.fromText " ") (map TL.fromString optList))

87− <> TL.fromText " #-}\n"

87+ ghcOptList

88− else mempty

89− optList = map TL.fromString

90− $ filter (\x -> not (isPrefixOf "-O" x))

88+ = filter (not . isPrefixOf "-O")

91− $ fromMaybe []

89+ $ fromMaybe []

92− $ lookup GHC (_cabalPackageInfo_compilerOptions packageInfo)

90+ $ lookup GHC (_cabalPackageInfo_compilerOptions packageInfo)

91+ optList = _cabalPackageInfo_cppOptions packageInfo <> ghcOptList

93

92

94lineNumberPragma :: FilePath -> TL.Builder

93lineNumberPragma :: FilePath -> TL.Builder

95−lineNumberPragma origPath =

96− TL.fromText "{-# LINE 1 \"" <> TL.fromString origPath <> TL.fromText "\" #-}\n"

94+lineNumberPragma origPath = pragma $ TL.fromText "LINE 1 " <> quoted '"' (TL.fromString origPath)

95+

96+pragma :: TL.Builder -> TL.Builder

97+pragma x = TL.fromText "{-# " <> x <> TL.fromText " #-}\n"

98+

99+quoted :: Char -> TL.Builder -> TL.Builder

100+quoted char x = TL.singleton char <> x <> TL.singleton char

lib/command/src/Obelisk/Command/Project.hs+26−15

@@ -15,6 +15,7 @@ module Obelisk.Command.Project

15 , toImplDir

16 , toObeliskDir

17 , withProjectRoot

18+ , bashEscape

18 ) where

19 ) where

19

20

20import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

21import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

@@ -23,6 +24,7 @@ import Control.Monad

23import Control.Monad.IO.Class (liftIO)

24import Control.Monad.IO.Class (liftIO)

24import Control.Monad.State

25import Control.Monad.State

25import qualified Data.Aeson as Json

26import qualified Data.Aeson as Json

27+import qualified Data.ByteString.UTF8 as BSU

26import Data.Bits

28import Data.Bits

27import qualified Data.ByteString.Lazy as BSL

29import qualified Data.ByteString.Lazy as BSL

28import Data.Default (def)

30import Data.Default (def)

@@ -30,15 +32,17 @@ import Data.Function ((&), on)

30import Data.Map (Map)

32import Data.Map (Map)

31import Data.Text (Text)

33import Data.Text (Text)

32import qualified Data.Text as T

34import qualified Data.Text as T

33−import Data.Text.Encoding (decodeUtf8)

35+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

34import Data.Traversable (for)

36import Data.Traversable (for)

35import System.Directory

37import System.Directory

36import System.Environment (lookupEnv)

38import System.Environment (lookupEnv)

37import System.FilePath

39import System.FilePath

38import System.IO.Temp

40import System.IO.Temp

39import System.IO.Unsafe (unsafePerformIO)

41import System.IO.Unsafe (unsafePerformIO)

40−import System.Posix (FileStatus, FileMode, CMode (..), UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)

42+import System.PosixCompat.Files

41−import System.Posix.Files

43+import System.PosixCompat.Types

44+import System.PosixCompat.User

45+import Text.ShellEscape (bash, bytes)

42

46

43import GitHub.Data.GitData (Branch)

47import GitHub.Data.GitData (Branch)

44import GitHub.Data.Name (Name)

48import GitHub.Data.Name (Name)

@@ -47,7 +51,7 @@ import Obelisk.App (MonadObelisk)

47import Obelisk.CliApp

51import Obelisk.CliApp

48import Obelisk.Command.Nix

52import Obelisk.Command.Nix

49import Obelisk.Command.Thunk

53import Obelisk.Command.Thunk

50−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath)

54+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)

51

55

52--TODO: Make this module resilient to random exceptions

56--TODO: Make this module resilient to random exceptions

53

57

@@ -112,7 +116,7 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

112 skel <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

116 skel <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

113

117

114 callProcessAndLogOutput (Notice, Error) $

118 callProcessAndLogOutput (Notice, Error) $

115− proc "cp"

119+ proc cp

116 [ "-r"

120 [ "-r"

117 , "--preserve=links"

121 , "--preserve=links"

118 , obDir

122 , obDir

@@ -122,7 +126,7 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

122

126

123 withSpinner "Copying project skeleton" $ do

127 withSpinner "Copying project skeleton" $ do

124 callProcessAndLogOutput (Notice, Error) $

128 callProcessAndLogOutput (Notice, Error) $

125− proc "cp"

129+ proc cp

126 [ "-r"

130 [ "-r"

127 , "--no-preserve=mode"

131 , "--no-preserve=mode"

128 , "-T"

132 , "-T"

@@ -133,6 +137,12 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

133 let configDir = "config"

137 let configDir = "config"

134 createDirectoryIfMissing False configDir

138 createDirectoryIfMissing False configDir

135 mapM_ (createDirectoryIfMissing False . (configDir </>)) ["backend", "common", "frontend"]

139 mapM_ (createDirectoryIfMissing False . (configDir </>)) ["backend", "common", "frontend"]

140+ putLog Notice $ T.intercalate "\n"

141+ [ "An obelisk project has been successfully initialized. Next steps:"

142+ , " 'ob run': Start a development server"

143+ , " 'ob watch': Watch for changes without starting a server"

144+ , " 'ob repl': Load your project into GHCi"

145+ ]

136

146

137callHandoffOb

147callHandoffOb

138 :: MonadObelisk m

148 :: MonadObelisk m

@@ -278,14 +288,17 @@ nixShellRunConfig root isPure command = do

278 pure $ def

288 pure $ def

279 & nixShellConfig_pure .~ isPure

289 & nixShellConfig_pure .~ isPure

280 & nixShellConfig_common . nixCmdConfig_target .~ (def & target_path .~ Nothing)

290 & nixShellConfig_common . nixCmdConfig_target .~ (def & target_path .~ Nothing)

281− & nixShellConfig_run .~ (command <&> \c -> mconcat

291+ & nixShellConfig_run .~ (command <&> \cs -> unwords $ concat

282− [ "export NIX_PATH=nixpkgs=", T.unpack nixpkgsPath, "; "

292+ [ ["export", BSU.toString . bytes . bash $ "NIX_PATH=nixpkgs=" <> encodeUtf8 nixpkgsPath, ";"]

283− , maybe "" (\v -> "export NIX_REMOTE=" <> v <> "; ") nixRemote

293+ , maybe [] (\v -> ["export", BSU.toString . bytes . bash $ "NIX_REMOTE=" <> encodeUtf8 (T.pack v), ";"]) nixRemote

284− , c

294+ , [cs]

285 ])

295 ])

286

296

297+bashEscape :: String -> String

298+bashEscape = BSU.toString . bytes . bash . BSU.fromString

299+

287nixShellRunProc :: NixShellConfig -> ProcessSpec

300nixShellRunProc :: NixShellConfig -> ProcessSpec

288−nixShellRunProc cfg = setDelegateCtlc True $ proc "nix-shell" $ runNixShellConfig cfg

301+nixShellRunProc cfg = setDelegateCtlc True $ proc nixShellPath $ runNixShellConfig cfg

289

302

290nixShellWithoutPkgs

303nixShellWithoutPkgs

291 :: MonadObelisk m

304 :: MonadObelisk m

@@ -300,7 +313,7 @@ nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr comma

300 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

313 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

301 defShellConfig <- nixShellRunConfig root isPure command

314 defShellConfig <- nixShellRunConfig root isPure command

302 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

315 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

303− (_, _, _, ph) <- createProcess_ "nixShellWithoutPkgs" $ setCwd_ $ nixShellRunProc $ defShellConfig

316+ runProcess_ $ setCwd_ $ nixShellRunProc $ defShellConfig

304 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

317 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

305 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

318 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

306 \shellPackages = builtins.fromJSON pkgs;\

319 \shellPackages = builtins.fromJSON pkgs;\

@@ -310,18 +323,16 @@ nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr comma

310 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

323 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

311 , strArg "shell" shellAttr

324 , strArg "shell" shellAttr

312 ]

325 ]

313− void $ waitForProcess ph

314

326

315nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

327nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

316nixShellWithHoogle root isPure shell' command = do

328nixShellWithHoogle root isPure shell' command = do

317 defShellConfig <- nixShellRunConfig root isPure command

329 defShellConfig <- nixShellRunConfig root isPure command

318− (_, _, _, ph) <- createProcess_ "nixShellWithHoogle" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

330+ runProcess_ $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

319 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

331 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

320 "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\

332 "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\

321 \userSettings = super.userSettings // { withHoogle = true; };\

333 \userSettings = super.userSettings // { withHoogle = true; };\

322 \})).project.shells.${shell}"

334 \})).project.shells.${shell}"

323 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

335 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

324− void $ waitForProcess ph

325

336

326findProjectAssets :: MonadObelisk m => FilePath -> m Text

337findProjectAssets :: MonadObelisk m => FilePath -> m Text

327findProjectAssets root = do

338findProjectAssets root = do

lib/command/src/Obelisk/Command/Run.hs+83−69

@@ -14,7 +14,7 @@ module Obelisk.Command.Run where

14import Control.Arrow ((&&&))

15import Control.Exception (Exception, bracket)

16import Control.Lens (ifor, (.~), (&))

17−import Control.Monad (filterM, unless, void)

17+import Control.Monad (filterM)

18import Control.Monad.Except (runExceptT, throwError)

19import Control.Monad.IO.Class (liftIO)

20import Control.Monad.Reader (MonadIO)

@@ -25,12 +25,14 @@ import Data.Default (def)

25import Data.Either (partitionEithers)

26import Data.Foldable (fold, for_, toList)

27import Data.Functor.Identity (runIdentity)

28+import Data.List (intercalate)

28import Data.List.NonEmpty (NonEmpty)

29import Data.List.NonEmpty (NonEmpty)

29import qualified Data.List.NonEmpty as NE

30import qualified Data.List.NonEmpty as NE

30import Data.Map (Map)

31import Data.Map (Map)

31import qualified Data.Map as Map

32import qualified Data.Map as Map

32import qualified Data.Map.Monoidal as MMap

33import qualified Data.Map.Monoidal as MMap

33−import Data.Maybe

34+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)

35+import Data.Ord (comparing)

34import Data.Set (Set)

36import Data.Set (Set)

35import qualified Data.Set as Set

37import qualified Data.Set as Set

36import Data.String.Here.Interpolated (i)

38import Data.String.Here.Interpolated (i)

@@ -44,17 +46,17 @@ import Distribution.Compiler (CompilerFlavor(..))

44import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

46import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

45import Distribution.Parsec.ParseResult (runParseResult)

47import Distribution.Parsec.ParseResult (runParseResult)

46import qualified Distribution.System as Dist

48import qualified Distribution.System as Dist

47−import Distribution.Types.BuildInfo

49+import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options)

48−import Distribution.Types.CondTree

50+import Distribution.Types.CondTree (simplifyCondTree)

49−import Distribution.Types.GenericPackageDescription

51+import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

50−import Distribution.Types.Library

52+import Distribution.Types.Library (libBuildInfo)

51−import Distribution.Utils.Generic

53+import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

52import qualified Distribution.Parsec.Common as Dist

54import qualified Distribution.Parsec.Common as Dist

53import qualified Hpack.Config as Hpack

55import qualified Hpack.Config as Hpack

54import qualified Hpack.Render as Hpack

56import qualified Hpack.Render as Hpack

55import qualified Hpack.Yaml as Hpack

57import qualified Hpack.Yaml as Hpack

56−import Language.Haskell.Extension

58+import Language.Haskell.Extension (Extension, Language)

57−import Network.Socket hiding (Debug)

59+import qualified Network.Socket as Socket

58import System.Directory

60import System.Directory

59import System.Environment (getExecutablePath)

61import System.Environment (getExecutablePath)

60import System.FilePath

62import System.FilePath

@@ -64,19 +66,18 @@ import System.IO.Temp (withSystemTempDirectory)

64import Obelisk.App (MonadObelisk)

66import Obelisk.App (MonadObelisk)

65import Obelisk.CliApp (

67import Obelisk.CliApp (

66 Severity (..),

68 Severity (..),

67− createProcess_,

68 failWith,

69 failWith,

69 proc,

70 proc,

70 putLog,

71 putLog,

71 readCreateProcessWithExitCode,

72 readCreateProcessWithExitCode,

72 readProcessAndLogStderr,

73 readProcessAndLogStderr,

74+ runProcess_,

73 setCwd,

75 setCwd,

74 setDelegateCtlc,

76 setDelegateCtlc,

75− waitForProcess,

76 withSpinner,

77 withSpinner,

77 )

78 )

78import Obelisk.Command.Nix

79import Obelisk.Command.Nix

79−import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets)

80+import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets, bashEscape)

80import Obelisk.Command.Thunk (attrCacheFileName)

81import Obelisk.Command.Thunk (attrCacheFileName)

81import Obelisk.Command.Utils (findExePath, ghcidExePath)

82import Obelisk.Command.Utils (findExePath, ghcidExePath)

82

83

@@ -93,9 +94,11 @@ data CabalPackageInfo = CabalPackageInfo

93 -- ^ List of globally set languages of the library component

94 -- ^ List of globally set languages of the library component

94 , _cabalPackageInfo_compilerOptions :: [(CompilerFlavor, [String])]

95 , _cabalPackageInfo_compilerOptions :: [(CompilerFlavor, [String])]

95 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)

96 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)

97+ , _cabalPackageInfo_cppOptions :: [String]

98+ -- ^ List of CPP (C Preprocessor) options (e.g. the "cpp-options" field of the cabal file)

96 }

99 }

97

100

98−-- | 'Bool' with a better name for it's purpose.

101+-- | 'Bool' with a better name for its purpose.

99data Interpret = Interpret_Interpret | Interpret_NoInterpret deriving (Eq, Ord, Show)

102data Interpret = Interpret_Interpret | Interpret_NoInterpret deriving (Eq, Ord, Show)

100

103

101textInterpret :: Interpret -> Text

104textInterpret :: Interpret -> Text

@@ -109,9 +112,6 @@ data PathTree a = PathTree_Node

109 (Map FilePath (PathTree a)) -- Branches to deeper leaves

112 (Map FilePath (PathTree a)) -- Branches to deeper leaves

110 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

113 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

111

114

112−emptyPathTree :: PathTree a

113−emptyPathTree = PathTree_Node Nothing mempty

114−

115-- | 2D ASCII drawing of a 'PathTree'. Adapted from Data.Tree.draw.

116drawPathTree :: (a -> Text) -> PathTree a -> Text

117drawPathTree showA (PathTree_Node _ ts0) = T.intercalate "\n" $ goForest (Map.toList ts0)

@@ -151,7 +151,7 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

151 liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName

152 putLog Debug $ "Storing profiled data under base name of " <> T.pack (root </> profileBaseName)

153 freePort <- getFreePort

154− (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $

154+ runProcess_ $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $

155 [ show freePort

156 , T.unpack assets

157 , profileBaseName

@@ -159,17 +159,16 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

159 , "-po" <> profileBaseName

160 ] <> rtsFlags

161 <> [ "-RTS" ]

162− void $ waitForProcess ph

163

162

164run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

163run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

165run root interpretPaths = do

164run root interpretPaths = do

166 pkgs <- getParsedLocalPkgs root interpretPaths

165 pkgs <- getParsedLocalPkgs root interpretPaths

167− withGhciScript pkgs $ \dotGhciPath -> do

168− assets <- findProjectAssets root

166+ assets <- findProjectAssets root

169− putLog Debug $ "Assets impurely loaded from: " <> assets

167+ putLog Debug $ "Assets impurely loaded from: " <> assets

170− ghciArgs <- getGhciSessionSettings pkgs root

168+ ghciArgs <- getGhciSessionSettings pkgs root True

171− freePort <- getFreePort

169+ freePort <- getFreePort

170+ withGhciScriptArgs pkgs $ \dotGhciArgs -> do

172− runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs $ Just $ unwords

171+ runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords

173 [ "Obelisk.Run.run"

172 [ "Obelisk.Run.run"

174 , show freePort

173 , show freePort

175 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

174 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

@@ -180,21 +179,21 @@ run root interpretPaths = do

180runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

179runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

181runRepl root interpretPaths = do

180runRepl root interpretPaths = do

182 pkgs <- getParsedLocalPkgs root interpretPaths

181 pkgs <- getParsedLocalPkgs root interpretPaths

183− ghciArgs <- getGhciSessionSettings pkgs "."

182+ ghciArgs <- getGhciSessionSettings pkgs "." True

184− withGhciScript pkgs $ \dotGhciPath ->

183+ withGhciScriptArgs pkgs $ \dotGhciArgs ->

185− runGhciRepl root pkgs (ghciArgs <> mkGhciScriptArg dotGhciPath)

184+ runGhciRepl root pkgs (ghciArgs <> dotGhciArgs)

186

185

187runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

186runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

188runWatch root interpretPaths = do

187runWatch root interpretPaths = do

189 pkgs <- getParsedLocalPkgs root interpretPaths

188 pkgs <- getParsedLocalPkgs root interpretPaths

190− ghciArgs <- getGhciSessionSettings pkgs root

189+ ghciArgs <- getGhciSessionSettings pkgs root True

191− withGhciScript pkgs $ \dotGhciPath ->

190+ withGhciScriptArgs pkgs $ \dotGhciArgs ->

192− runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs Nothing

191+ runGhcid root True (ghciArgs <> dotGhciArgs) pkgs Nothing

193

192

194−exportGhciConfig :: MonadObelisk m => FilePath -> PathTree Interpret -> m [String]

193+exportGhciConfig :: MonadObelisk m => Bool -> FilePath -> PathTree Interpret -> m [String]

195−exportGhciConfig root interpretPaths = do

194+exportGhciConfig useRelativePaths root interpretPaths = do

196 pkgs <- getParsedLocalPkgs root interpretPaths

195 pkgs <- getParsedLocalPkgs root interpretPaths

197− getGhciSessionSettings pkgs "."

196+ getGhciSessionSettings pkgs "." useRelativePaths

198

197

199nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()

198nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()

200nixShellForInterpretPaths isPure shell root interpretPaths cmd = do

199nixShellForInterpretPaths isPure shell root interpretPaths cmd = do

@@ -305,15 +304,16 @@ parseCabalPackage

305 -> m (Maybe CabalPackageInfo)

304 -> m (Maybe CabalPackageInfo)

306parseCabalPackage dir = parseCabalPackage' dir >>= \case

305parseCabalPackage dir = parseCabalPackage' dir >>= \case

307 Left err -> Nothing <$ putLog Error err

306 Left err -> Nothing <$ putLog Error err

308− Right (warnings, pkgInfo) -> do

307+ Right (Just (warnings, pkgInfo)) -> do

309 for_ warnings $ putLog Warning . T.pack . show

308 for_ warnings $ putLog Warning . T.pack . show

310 pure $ Just pkgInfo

309 pure $ Just pkgInfo

310+ Right Nothing -> pure Nothing

311

312-- | Like 'parseCabalPackage' but returns errors and warnings directly so as to avoid 'MonadObelisk'.

313parseCabalPackage'

314 :: (MonadIO m)

315 => FilePath -- ^ Package directory

316− -> m (Either T.Text ([Dist.PWarning], CabalPackageInfo))

316+ -> m (Either T.Text (Maybe ([Dist.PWarning], CabalPackageInfo)))

317parseCabalPackage' pkg = runExceptT $ do

318 (cabalContents, packageFile, packageName) <- guessCabalPackageFile pkg >>= \case

319 Left GuessPackageFileError_NotFound -> throwError $ "No .cabal or package.yaml file found in " <> T.pack pkg

@@ -341,7 +341,7 @@ parseCabalPackage' pkg = runExceptT $ do

341 case condLibrary <$> result of

342 Right (Just condLib) -> do

343 let (_, lib) = simplifyCondTree evalConfVar condLib

344− pure $ (warnings,) $ CabalPackageInfo

344+ pure $ Just $ (warnings,) $ CabalPackageInfo

345 { _cabalPackageInfo_packageName = T.pack packageName

346 , _cabalPackageInfo_packageFile = packageFile

347 , _cabalPackageInfo_packageRoot = takeDirectory packageFile

@@ -353,18 +353,19 @@ parseCabalPackage' pkg = runExceptT $ do

353 , _cabalPackageInfo_defaultLanguage =

354 defaultLanguage $ libBuildInfo lib

355 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

356+ , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib

356 }

357 }

357− Right Nothing -> throwError "Haskell package has no library component"

358+ Right Nothing -> pure Nothing

358 Left (_, errors) ->

359 Left (_, errors) ->

359 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)

360 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)

360

361

361parsePackagesOrFail :: (MonadObelisk m, Foldable f) => f FilePath -> m (NE.NonEmpty CabalPackageInfo)

362parsePackagesOrFail :: (MonadObelisk m, Foldable f) => f FilePath -> m (NE.NonEmpty CabalPackageInfo)

362parsePackagesOrFail dirs' = do

363parsePackagesOrFail dirs' = do

363− (pkgDirErrs, packageInfos') <- fmap partitionEithers $ for dirs $ \dir -> do

364+ packageInfos' <- fmap catMaybes $ for dirs $ \dir -> do

364 flip fmap (parseCabalPackage dir) $ \case

365 flip fmap (parseCabalPackage dir) $ \case

365 Just packageInfo

366 Just packageInfo

366− | _cabalPackageInfo_buildable packageInfo -> Right packageInfo

367+ | _cabalPackageInfo_buildable packageInfo -> Just packageInfo

367− _ -> Left dir

368+ _ -> Nothing

368

369

369 -- Sort duplicate packages such that we prefer shorter paths, but fall back to alphabetical ordering.

370 -- Sort duplicate packages such that we prefer shorter paths, but fall back to alphabetical ordering.

370 let packagesByName = Map.map (NE.sortBy $ comparing $ \p -> let n = _cabalPackageInfo_packageFile p in (length n, n))

371 let packagesByName = Map.map (NE.sortBy $ comparing $ \p -> let n = _cabalPackageInfo_packageFile p in (length n, n))

@@ -386,9 +387,6 @@ parsePackagesOrFail dirs' = do

386 "No valid, buildable packages found" <> (if null dirs then "" else " in " <> intercalate ", " dirs)

387 "No valid, buildable packages found" <> (if null dirs then "" else " in " <> intercalate ", " dirs)

387 Just xs -> pure xs

388 Just xs -> pure xs

388

389

389− unless (null pkgDirErrs) $

390− putLog Warning $ T.pack $ "Failed to find buildable packages in " <> intercalate ", " pkgDirErrs

391−

392 pure packageInfos

390 pure packageInfos

393 where

391 where

394 dirs = toList dirs'

392 dirs = toList dirs'

@@ -396,13 +394,29 @@ parsePackagesOrFail dirs' = do

396packageInfoToNamePathMap :: Foldable f => f CabalPackageInfo -> Map Text FilePath

394packageInfoToNamePathMap :: Foldable f => f CabalPackageInfo -> Map Text FilePath

397packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot) . toList

395packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot) . toList

398

396

397+-- Like 'withGhciScript' but provides the precise ghci arguments to add to a ghci session

398+withGhciScriptArgs

399+ :: (MonadObelisk m, Foldable f)

400+ => f CabalPackageInfo -- ^ List of packages to load into ghci

401+ -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments

402+ -> m ()

403+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]

404+ where

405+ -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@

406+ -- is passed to the ghci session.

407+ loadPreludeManually =

408+ [ ":add Prelude" -- @:add@ is used because it's less noisy when there is no custom Prelude

409+ , ":set -XImplicitPrelude" -- Turn the default setting on

410+ ]

411+

399-- | Create ghci configuration to load the given packages

412-- | Create ghci configuration to load the given packages

400withGhciScript

413withGhciScript

401 :: (MonadObelisk m, Foldable f)

414 :: (MonadObelisk m, Foldable f)

415+ => [String] -- ^ Commands to prefix to file

402− => f CabalPackageInfo -- ^ List of packages to load into ghci

416+ -> f CabalPackageInfo -- ^ List of packages to load into ghci

403 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

417 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

404 -> m ()

418 -> m ()

405−withGhciScript (toList -> packageInfos) f =

419+withGhciScript preCommands (toList -> packageInfos) f =

406 withSystemTempDirectory "ob-ghci" $ \fp -> do

420 withSystemTempDirectory "ob-ghci" $ \fp -> do

407 let dotGhciPath = fp </> ".ghci"

421 let dotGhciPath = fp </> ".ghci"

408 liftIO $ writeFile dotGhciPath dotGhci

422 liftIO $ writeFile dotGhciPath dotGhci

@@ -414,7 +428,8 @@ withGhciScript (toList -> packageInfos) f =

414 , [ "Backend" | "backend" `Set.member` packageNames ]

428 , [ "Backend" | "backend" `Set.member` packageNames ]

415 , [ "Frontend" | "frontend" `Set.member` packageNames ]

429 , [ "Frontend" | "frontend" `Set.member` packageNames ]

416 ]

430 ]

417− dotGhci = unlines

431+ dotGhci = unlines $

432+ preCommands <>

418 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

433 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

419 , "import qualified Obelisk.Run"

434 , "import qualified Obelisk.Run"

420 , "import qualified Frontend"

435 , "import qualified Frontend"

@@ -427,8 +442,9 @@ getGhciSessionSettings

427 :: (MonadObelisk m, Foldable f)

442 :: (MonadObelisk m, Foldable f)

428 => f CabalPackageInfo -- ^ List of packages to load into ghci

443 => f CabalPackageInfo -- ^ List of packages to load into ghci

429 -> FilePath -- ^ All paths will be relative to this path

444 -> FilePath -- ^ All paths will be relative to this path

445+ -> Bool -- ^ Use relative paths

430 -> m [String]

446 -> m [String]

431−getGhciSessionSettings (toList -> packageInfos) pathBase = do

447+getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

432 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that

448 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that

433 -- paths-with-spaces ruin our day, we first canonicalize everything, and then relativize

449 -- paths-with-spaces ruin our day, we first canonicalize everything, and then relativize

434 -- all paths to 'pathBase'.

450 -- all paths to 'pathBase'.

@@ -438,13 +454,15 @@ getGhciSessionSettings (toList -> packageInfos) pathBase = do

438 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

454 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

439 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

455 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

440 canonicalPkgFile <- canonicalizePath $ _cabalPackageInfo_packageFile pkg

456 canonicalPkgFile <- canonicalizePath $ _cabalPackageInfo_packageFile pkg

441− pure (canonicalPkgFile `relativeTo` canonicalPathBase, (`relativeTo` canonicalPathBase) <$> canonicalSrcDirs)

457+ pure (canonicalPkgFile `relativeTo'` canonicalPathBase, (`relativeTo'` canonicalPathBase) <$> canonicalSrcDirs)

442

458

443 pure

459 pure

444 $ baseGhciOptions

460 $ baseGhciOptions

445 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

461 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

446 <> concatMap (\p -> ["-optF", p]) pkgFiles

462 <> concatMap (\p -> ["-optF", p]) pkgFiles

447 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

463 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

464+ where

465+ relativeTo' = if useRelativePaths then relativeTo else const

448

466

449baseGhciOptions :: [String]

467baseGhciOptions :: [String]

450baseGhciOptions =

468baseGhciOptions =

@@ -464,7 +482,7 @@ runGhciRepl root (toList -> packages) ghciArgs =

464 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

482 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

465 -- ghc that is provided by the shell in the user's project.

483 -- ghc that is provided by the shell in the user's project.

466 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

484 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

467− Just $ unwords $ "ghci" : ghciArgs -- TODO: Shell escape

485+ Just $ unwords $ fmap bashEscape $ "ghci" : ghciArgs

468

486

469-- | Run ghcid

487-- | Run ghcid

470runGhcid

488runGhcid

@@ -477,32 +495,28 @@ runGhcid

477 -> m ()

495 -> m ()

478runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

496runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

479 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

497 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

480− Just $ unwords $ ghcidExePath : opts -- TODO: Shell escape

498+ Just $ unwords $ fmap bashEscape $ ghcidExePath : opts

481 where

499 where

482− opts =

500+ opts = concat

483− [ "-W"

501+ [ ["-W"]

484− , "--outputfile=ghcid-output.txt"

502+ , ["--outputfile=ghcid-output.txt"]

485− ] <> map (\x -> "--reload='" <> x <> "'") reloadFiles

503+ , map (\x -> "--reload=" <> x) reloadFiles

486− <> map (\x -> "--restart='" <> x <> "'") restartFiles

504+ , map (\x -> "--restart=" <> x) restartFiles

487− <> testCmd

505+ , maybe [] (\cmd -> ["--test=" <> cmd]) mcmd

488− <> ["--command='" <> unwords ("ghci" : ghciArgs) <> "'"] -- TODO: Shell escape

506+ , ["--command=" <> unwords ("ghci" : ghciArgs)]

489− testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'") -- TODO: Shell escape

507+ ]

490−

491 adjustRoot x = if chdirToRoot then makeRelative root x else x

508 adjustRoot x = if chdirToRoot then makeRelative root x else x

492 reloadFiles = map adjustRoot [root </> "config"]

509 reloadFiles = map adjustRoot [root </> "config"]

493 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

510 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

494

511

495−mkGhciScriptArg :: FilePath -> [String]

496−mkGhciScriptArg dotGhci = ["-ghci-script", dotGhci]

497−

498−getFreePort :: MonadIO m => m PortNumber

512+getFreePort :: MonadIO m => m Socket.PortNumber

499−getFreePort = liftIO $ withSocketsDo $ do

513+getFreePort = liftIO $ Socket.withSocketsDo $ do

500− addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")

514+ addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")

501− bracket (open addr) close socketPort

515+ bracket (open addr) Socket.close Socket.socketPort

502 where

516 where

503 open addr = do

517 open addr = do

504− sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

518+ sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)

505− bind sock (addrAddress addr)

519+ Socket.bind sock (Socket.addrAddress addr)

506 return sock

520 return sock

507

521

508

522

@@ -537,4 +551,4 @@ relativeTo dir base

537 $ zipDefaultWith Nothing Nothing (,)

551 $ zipDefaultWith Nothing Nothing (,)

538 (map Just $ splitDirectories base)

552 (map Just $ splitDirectories base)

539 (map Just $ splitDirectories dir)

553 (map Just $ splitDirectories dir)

540− where collapse = foldr (</>) ""

554+ where collapse = foldr (</>) ""

lib/command/src/Obelisk/Command/Thunk.hs+22−32

@@ -14,13 +14,14 @@ import Control.Applicative

14import Control.Exception (displayException, try)

15import Control.Lens (ifor, ifor_, (.~))

16import Control.Monad

17−import Control.Monad.Extra (findM, unlessM, whenM)

17+import Control.Monad.Extra (findM)

18import Control.Monad.Catch (MonadCatch, handle)

19import Control.Monad.Except

20import Data.Aeson ((.=))

21import qualified Data.Aeson as Aeson

22import Data.Aeson.Encode.Pretty

23import qualified Data.Aeson.Types as Aeson

24+import Data.Bifunctor (first)

24import qualified Data.ByteString.Lazy as LBS

25import qualified Data.ByteString.Lazy as LBS

25import Data.Containers.ListUtils (nubOrd)

26import Data.Containers.ListUtils (nubOrd)

26import Data.Default

27import Data.Default

@@ -55,7 +56,7 @@ import System.Exit

55import System.FilePath

56import System.FilePath

56import System.IO.Error

57import System.IO.Error

57import System.IO.Temp

58import System.IO.Temp

58−import System.Posix (getSymbolicLinkStatus, modificationTime)

59+import System.PosixCompat.Files (getSymbolicLinkStatus, modificationTime)

59import qualified Text.URI as URI

60import qualified Text.URI as URI

60

61

61import Obelisk.App (MonadObelisk)

62import Obelisk.App (MonadObelisk)

@@ -177,14 +178,14 @@ getNixSha256ForUriUnpacked

177getNixSha256ForUriUnpacked uri =

178getNixSha256ForUriUnpacked uri =

178 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

179 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

179 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

180 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

180− proc "nix-prefetch-url" ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

181+ proc nixPrefetchUrlPath ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

181 pure hash

182 pure hash

182

183

183nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

184nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

184nixPrefetchGit uri rev fetchSubmodules =

185nixPrefetchGit uri rev fetchSubmodules =

185 withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

186 withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

186 out <- readProcessAndLogStderr Debug $

187 out <- readProcessAndLogStderr Debug $

187− proc "nix-prefetch-git" $ filter (/="")

188+ proc nixPrefetchGitPath $ filter (/="")

188 [ "--url", T.unpack $ gitUriToText uri

189 [ "--url", T.unpack $ gitUriToText uri

189 , "--rev", T.unpack rev

190 , "--rev", T.unpack rev

190 , if fetchSubmodules then "--fetch-submodules" else ""

191 , if fetchSubmodules then "--fetch-submodules" else ""

@@ -208,7 +209,7 @@ data ReadThunkError

208 deriving (Show)

209 deriving (Show)

209

210

210unpackedDirName :: FilePath

211unpackedDirName :: FilePath

211−unpackedDirName = "local"

212+unpackedDirName = "."

212

213

213attrCacheFileName :: FilePath

214attrCacheFileName :: FilePath

214attrCacheFileName = ".attr-cache"

215attrCacheFileName = ".attr-cache"

@@ -356,7 +357,7 @@ overwriteThunk target thunk = do

356 Right _ -> pure ()

357 Right _ -> pure ()

357

358

358 --TODO: Is there a safer way to do this overwriting?

359 --TODO: Is there a safer way to do this overwriting?

359− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", target] -- target may be a symlink

360+ liftIO $ removePathForcibly target

360 createThunk target $ Right thunk

361 createThunk target $ Right thunk

361

362

362thunkPtrToSpec :: ThunkPtr -> ThunkSpec

363thunkPtrToSpec :: ThunkPtr -> ThunkSpec

@@ -409,21 +410,6 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

409 , confTrailingNewline = True

410 , confTrailingNewline = True

410 }

411 }

411

412

412−-- | Initialize a git repository to an unpacked thunk.

413−initThunk :: MonadObelisk m => FilePath -> m ()

414−initThunk target = withSpinner [i|Initializing thunk at ${target}|] $ do

415− checkThunkDirectory target

416− unlessM (liftIO $ doesDirectoryExist $ target </> ".git") $ failWith [i|${target} is not a git checkout.|]

417− ptr <- getThunkPtr CheckClean_NoCheck target Nothing

418− let tempThunkDir = target <.> "thunk-init"

419− whenM (liftIO $ doesPathExist tempThunkDir) $

420− failWith [i|A previous 'thunk init' left unfinished state at ${tempThunkDir}. You will need to rename or remove that path before trying again.|]

421− createThunk tempThunkDir $ Left (thunkPtrToSpec ptr) -- Only write the skeleton, but skip the ptr itself since it's unpacked

422− liftIO $ do

423− renameDirectory target (tempThunkDir </> unpackedDirName)

424− removePathForcibly target

425− renameDirectory tempThunkDir target

426−

427createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()

413createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()

428createThunk target ptrInfo =

414createThunk target ptrInfo =

429 ifor_ (_thunkSpec_files spec) $ \path -> \case

415 ifor_ (_thunkSpec_files spec) $ \path -> \case

@@ -555,7 +541,7 @@ let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256

555 inherit owner repo rev sha256 fetchSubmodules private;

541 inherit owner repo rev sha256 fetchSubmodules private;

556 };

542 };

557 json = builtins.fromJSON (builtins.readFile ./github.json);

543 json = builtins.fromJSON (builtins.readFile ./github.json);

558−in if builtins.pathExists ./local then ./local else fetch json

544+in fetch json

559|]

545|]

560

546

561parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

547parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -647,7 +633,7 @@ let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, pr

647 url = realUrl; inherit rev sha256;

633 url = realUrl; inherit rev sha256;

648 };

634 };

649 json = builtins.fromJSON (builtins.readFile ./git.json);

635 json = builtins.fromJSON (builtins.readFile ./git.json);

650−in if builtins.pathExists ./local then ./local else fetch json

636+in fetch json

651|]

637|]

652

638

653parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

639parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -659,7 +645,7 @@ mkThunkSpec name jsonFileName parser srcNix = ThunkSpec name $ Map.fromList

659 , ("thunk.nix", ThunkFileSpec_FileMatches srcNix)

645 , ("thunk.nix", ThunkFileSpec_FileMatches srcNix)

660 , (jsonFileName, ThunkFileSpec_Ptr parser)

646 , (jsonFileName, ThunkFileSpec_Ptr parser)

661 , (attrCacheFileName, ThunkFileSpec_AttrCache)

647 , (attrCacheFileName, ThunkFileSpec_AttrCache)

662− , (unpackedDirName, ThunkFileSpec_CheckoutIndicator)

648+ , (normalise $ unpackedDirName </> ".git", ThunkFileSpec_CheckoutIndicator)

663 ]

649 ]

664 where

650 where

665 defaultNixViaSrc = [here|

651 defaultNixViaSrc = [here|

@@ -699,7 +685,7 @@ nixBuildThunkAttrWithCache thunkSpec thunkDir attr = do

699 for cachePaths' $ \cachePaths ->

685 for cachePaths' $ \cachePaths ->

700 fmap NonEmpty.head $ for cachePaths $ \cacheDir -> do

686 fmap NonEmpty.head $ for cachePaths $ \cacheDir -> do

701 let

687 let

702− cachePath = cacheDir </> attr <.> "out"

688+ cachePath = thunkDir </> cacheDir </> attr <.> "out"

703 cacheErrHandler e

689 cacheErrHandler e

704 | isDoesNotExistError e = pure Nothing -- expected from a cache miss

690 | isDoesNotExistError e = pure Nothing -- expected from a cache miss

705 | otherwise = Nothing <$ putLog Error (T.pack $ displayException e)

691 | otherwise = Nothing <$ putLog Error (T.pack $ displayException e)

@@ -773,9 +759,6 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

773finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

759finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

774finalMsg noTrail s = if noTrail then Nothing else Just s

760finalMsg noTrail s = if noTrail then Nothing else Just s

775

761

776−unpackThunk :: MonadObelisk m => FilePath -> m ()

777−unpackThunk = unpackThunk' False

778−

779-- | Check that we are not somewhere inside the thunk directory

762-- | Check that we are not somewhere inside the thunk directory

780checkThunkDirectory :: MonadObelisk m => FilePath -> m ()

763checkThunkDirectory :: MonadObelisk m => FilePath -> m ()

781checkThunkDirectory thunkDir = do

764checkThunkDirectory thunkDir = do

@@ -790,6 +773,9 @@ checkThunkDirectory thunkDir = do

790 Right _ -> failWith [i|Refusing to perform thunk operation on ${thunkDir} because it is a thunk's unpacked source|]

773 Right _ -> failWith [i|Refusing to perform thunk operation on ${thunkDir} because it is a thunk's unpacked source|]

791 Left _ -> pure ()

774 Left _ -> pure ()

792

775

776+unpackThunk :: MonadObelisk m => FilePath -> m ()

777+unpackThunk = unpackThunk' False

778+

793unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()

779unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()

794unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkDir >>= \case

780unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkDir >>= \case

795 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]

781 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]

@@ -805,9 +791,12 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD

805 ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs

791 ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs

806 withSpinner' ("Fetching thunk " <> T.pack thunkName)

792 withSpinner' ("Fetching thunk " <> T.pack thunkName)

807 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

793 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

794+ let unpackedPath = tmpThunk </> unpackedDirName

808− gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) (tmpThunk </> unpackedDirName)

795+ gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) unpackedPath

809

796

797+ let normalizeMore = dropTrailingPathSeparator . normalise

798+ when (normalizeMore unpackedPath /= normalizeMore tmpThunk) $ -- Only write meta data if the checkout is not inplace

810− createThunk tmpThunk $ Left newSpec

799+ createThunk tmpThunk $ Left newSpec

811

800

812 liftIO $ do

801 liftIO $ do

813 removePathForcibly thunkDir

802 removePathForcibly thunkDir

@@ -843,7 +832,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire

843 do

832 do

844 let checkClean = if force then CheckClean_NoCheck else CheckClean_FullCheck

833 let checkClean = if force then CheckClean_NoCheck else CheckClean_FullCheck

845 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr checkClean thunkDir (_thunkConfig_private thunkConfig)

834 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr checkClean thunkDir (_thunkConfig_private thunkConfig)

846− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir] -- thunkDir may be a symlink

835+ liftIO $ removePathForcibly thunkDir

847 createThunk thunkDir $ Right thunkPtr

836 createThunk thunkDir $ Right thunkPtr

848 pure thunkPtr

837 pure thunkPtr

849

838

@@ -865,7 +854,8 @@ data CheckClean

865

854

866getThunkPtr :: forall m. MonadObelisk m => CheckClean -> FilePath -> Maybe Bool -> m ThunkPtr

855getThunkPtr :: forall m. MonadObelisk m => CheckClean -> FilePath -> Maybe Bool -> m ThunkPtr

867getThunkPtr gitCheckClean dir mPrivate = do

856getThunkPtr gitCheckClean dir mPrivate = do

857+ let repoLocations = nubOrd $ map (first normalise)

868− let repoLocations = [(".git", "."), (unpackedDirName, unpackedDirName)]

858+ [(".git", "."), (unpackedDirName </> ".git", unpackedDirName)]

869 repoLocation' <- liftIO $ flip findM repoLocations $ doesDirectoryExist . (dir </>) . fst

859 repoLocation' <- liftIO $ flip findM repoLocations $ doesDirectoryExist . (dir </>) . fst

870 thunkDir <- case repoLocation' of

860 thunkDir <- case repoLocation' of

871 Nothing -> failWith [i|Can't find an unpacked thunk in ${dir}|]

861 Nothing -> failWith [i|Can't find an unpacked thunk in ${dir}|]

lib/command/src/Obelisk/Command/Utils.hs+34−2

@@ -54,6 +54,38 @@ nixBuildExePath = $(staticWhich "nix-build")

54jreKeyToolPath :: FilePath

55jreKeyToolPath = $(staticWhich "keytool")

56

57+nixPrefetchGitPath :: FilePath

58+nixPrefetchGitPath = $(staticWhich "nix-prefetch-git")

59+

60+nixPrefetchUrlPath :: FilePath

61+nixPrefetchUrlPath = $(staticWhich "nix-prefetch-url")

62+

63+nixShellPath :: FilePath

64+nixShellPath = $(staticWhich "nix-shell")

65+

66+rsyncPath :: FilePath

67+rsyncPath = $(staticWhich "rsync")

68+

69+sshPath :: FilePath

70+sshPath = $(staticWhich "ssh")

71+

72+gitPath :: FilePath

73+gitPath = $(staticWhich "git")

74+

75+whichPath :: FilePath

76+whichPath = $(staticWhich "which")

77+

78+sshKeygenPath :: FilePath

79+sshKeygenPath = $(staticWhich "ssh-keygen")

80+

81+-- $(staticWhich "docker") was intentionally omitted, at least for now

82+-- One concern is that I don't know how particular docker is about having the

83+-- CLI exe match the version of the docker daemon, which is largely outside of

84+-- the control of obelisk-command.

85+-- TODO: Investigate the tradeoffs associated with this choice

86+dockerPath :: FilePath

87+dockerPath = "docker"

88+

57-- | Nix syntax requires relative paths to be prefixed by @./@ or

89-- | Nix syntax requires relative paths to be prefixed by @./@ or

58-- @../@. This will make a 'FilePath' that can be embedded in a Nix

90-- @../@. This will make a 'FilePath' that can be embedded in a Nix

59-- expression.

91-- expression.

@@ -91,7 +123,7 @@ initGit repo = do

91 git ["commit", "-m", "Initial commit."]

123 git ["commit", "-m", "Initial commit."]

92

124

93gitProcNoRepo :: [String] -> ProcessSpec

125gitProcNoRepo :: [String] -> ProcessSpec

94−gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc "git" args

126+gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc gitPath args

95

127

96gitProc :: FilePath -> [String] -> ProcessSpec

128gitProc :: FilePath -> [String] -> ProcessSpec

97gitProc repo = gitProcNoRepo . runGitInDir

129gitProc repo = gitProcNoRepo . runGitInDir

@@ -108,7 +140,7 @@ isolateGitProc = setEnvOverride (overrides <>)

108 , ("GIT_CONFIG_NOSYSTEM", "1")

140 , ("GIT_CONFIG_NOSYSTEM", "1")

109 , ("GIT_TERMINAL_PROMPT", "0") -- git 2.3+

141 , ("GIT_TERMINAL_PROMPT", "0") -- git 2.3+

110 , ("GIT_ASKPASS", "echo") -- pre git 2.3 to just use empty password

142 , ("GIT_ASKPASS", "echo") -- pre git 2.3 to just use empty password

111− , ("GIT_SSH_COMMAND", "ssh -o PreferredAuthentications password -o PubkeyAuthentication no -o GSSAPIAuthentication no")

143+ , ("GIT_SSH_COMMAND", "ssh -o PreferredAuthentications=password -o PubkeyAuthentication=no -o GSSAPIAuthentication=no")

112 ]

144 ]

113

145

114-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

146-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

lib/command/src/Obelisk/Command/VmBuilder.hs+8−8

@@ -21,7 +21,7 @@ import qualified System.Info

21

22import Obelisk.App (MonadObelisk, getObeliskUserStateDir)

23import Obelisk.CliApp

24−import Obelisk.Command.Utils (rmPath)

24+import Obelisk.Command.Utils (rmPath, whichPath, sshKeygenPath, nixBuildExePath, dockerPath)

25

26-- | Generate the `--builders` argument string to enable the VM builder after ensuring it is available.

27getNixBuildersArg :: MonadObelisk m => m String

@@ -35,7 +35,7 @@ getNixBuildersArg = do

35

36checkForNixDarwin :: MonadObelisk m => String -> m ()

37checkForNixDarwin sshIdFile = do

38− (exitCode, _, _) <- readCreateProcessWithExitCode $ proc "which" ["darwin-rebuild"]

38+ (exitCode, _, _) <- readCreateProcessWithExitCode $ proc whichPath ["darwin-rebuild"]

39 unless (exitCode == ExitSuccess) $ failWith $ T.intercalate "\n"

40 [ "Deployments from macOS require nix-darwin to be installed."

41 , "Follow the installation instructions here: https://github.com/LnL7/nix-darwin"

@@ -67,7 +67,7 @@ containerExists :: MonadObelisk m => FilePath -> m Bool

67containerExists stateDir = handle (\(_ :: IOError) -> failWith needDockerMsg) $ do

68 containerNames <- fmap (map T.strip . T.lines) $

69 readProcessAndLogStderr Error $

70− proc "docker" ["container", "list", "--all", "--format", "{{.Names}}"]

70+ proc dockerPath ["container", "list", "--all", "--format", "{{.Names}}"]

71 let exists = containerName `elem` containerNames

72 when exists $ testLinuxBuild stateDir

73 pure exists

@@ -85,7 +85,7 @@ containerSshPort = 2222

85startContainer :: MonadObelisk m => m ()

86startContainer = withSpinner "Starting VM builder" $

87 callProcessAndLogOutput (Debug, Debug) $

88− proc "docker" ["start", containerName]

88+ proc dockerPath ["start", containerName]

89

90-- | Creates the Docker container; assumes it does not exist.

91setupNixDocker :: MonadObelisk m => FilePath -> m ()

@@ -98,12 +98,12 @@ setupNixDocker stateDir = withSpinner ("Creating Docker container named " <> con

98 callProcessAndLogOutput (Debug, Error) $

99 proc rmPath ["-f", stateDir </> sshKeyFileName, stateDir </> sshKeyFileName <.> "pub"]

100 callProcessAndLogOutput (Debug, Error) $

101− proc "ssh-keygen" ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]

101+ proc sshKeygenPath ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]

102

103 -- Build the docker container (which uses the SSH keys in the 'ssh' folder)

104 containerId <- fmap T.strip $ readProcessAndLogStderr Error $

105− proc "docker" ["build", stateDir, "--quiet"]

105+ proc dockerPath ["build", stateDir, "--quiet"]

106− callProcessAndLogOutput (Debug, Error) $ proc "docker"

106+ callProcessAndLogOutput (Debug, Error) $ proc dockerPath

107 [ "run"

108 , "--restart", "always"

109 , "--detach"

@@ -155,7 +155,7 @@ testLinuxBuild :: MonadObelisk m => FilePath -> m ()

155testLinuxBuild stateDir

156 | System.Info.os == "linux" = failWith "Using the docker builder is not necessary on linux."

157 | otherwise = do

158− (exitCode, _stdout, stderr) <- readCreateProcessWithExitCode $ proc "nix-build"

158+ (exitCode, _stdout, stderr) <- readCreateProcessWithExitCode $ proc nixBuildExePath

159 [ "--no-out-link"

160 , "-E", "(import <nixpkgs> { system = \"x86_64-linux\"; }).writeText \"test\" builtins.currentTime"

161 , "--builders", nixBuildersArgString stateDir

lib/executable-config/default.nix+15−2

@@ -19,12 +19,25 @@ let

19 exit 1

20 fi

21 cp -a "${config}"/* "$out/config"

22+ # Needed for android deployments

23+ find "$out/config" -type f -printf '%P\0' > "$out/config.files"

22 '');

24 '');

23in

25in

24

26

25{

27{

26− haskellOverlay = self: super: {

28+ haskellOverlay = self: super:

29+ let

30+ pkgs = self.callPackage ({pkgs}: pkgs) {};

31+ in {

32+ obelisk-executable-config-lookup = pkgs.haskell.lib.overrideCabal

27− obelisk-executable-config-lookup = self.callCabal2nix "obelisk-executable-config-lookup" (obeliskCleanSource ./lookup) {};

33+ (self.callCabal2nix "obelisk-executable-config-lookup" (obeliskCleanSource ./lookup) {})

34+ (drv: {

35+ # Hack until https://github.com/NixOS/cabal2nix/pull/432 lands

36+ libraryHaskellDepends = (drv.libraryHaskellDepends or [])

37+ ++ pkgs.stdenv.lib.optionals (with pkgs.stdenv.hostPlatform; isAndroid && is32bit) [

38+ self.android-activity

39+ ];

40+ });

28 };

41 };

29

42

30 platforms = {

43 platforms = {

lib/executable-config/inject/obelisk-executable-config-inject.cabal+1−1

@@ -15,4 +15,4 @@ library

15 text

16

17 exposed-modules: Obelisk.ExecutableConfig.Inject

18− ghc-options: -Wall

18+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/executable-config/lookup/obelisk-executable-config-lookup.cabal+10−7

@@ -31,15 +31,18 @@ library

31 base64-bytestring,

32 bytestring,

33 containers,

34+ exceptions,

34 filepath,

35 filepath,

35− text,

36+ jsaddle,

36− transformers,

37+ mmorph,

37− transformers-base,

38− ref-tf,

39− primitive,

40 monad-control,

38 monad-control,

39+ mtl,

40+ primitive,

41+ ref-tf,

42+ reflex-dom-core,

41 reflex,

43 reflex,

42− reflex-dom,

44+ text,

43− jsaddle

45+ transformers-base,

46+ transformers

44

47

45 ghc-options: -Wall

48 ghc-options: -Wall

lib/executable-config/lookup/src/Obelisk/Configs.hs+31−12

@@ -18,24 +18,38 @@ module Obelisk.Configs

18 , getTextConfig

19 ) where

20

21−import Control.Applicative

21+import Control.Applicative (Alternative)

22−import Control.Monad

22+import Control.Monad (MonadPlus)

23−import Control.Monad.Base

23+import Control.Monad.Base (MonadBase)

24+import Control.Monad.Catch (MonadThrow)

25+import Control.Monad.Fail (MonadFail)

24−import Control.Monad.Fix

26+import Control.Monad.Fix (MonadFix)

27+import Control.Monad.IO.Class (MonadIO)

28+import Control.Monad.Morph (MFunctor)

25−import Control.Monad.Primitive

29+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)

26−import Control.Monad.Ref

30+import Control.Monad.Ref (MonadRef)

27−import Control.Monad.IO.Class

28−import Control.Monad.Trans.Class

31+import Control.Monad.Trans (MonadTrans, lift)

29−import Control.Monad.Trans.Control

32+import Control.Monad.Trans.Control (MonadBaseControl)

30−import Control.Monad.Trans.Reader

33+import Control.Monad.Trans.Reader (ReaderT (..), ask, mapReaderT)

34+import Control.Monad.Trans.State (StateT)

35+import qualified Control.Monad.Trans.State.Strict as Strict

31import Data.ByteString (ByteString)

36import Data.ByteString (ByteString)

32import Data.Map (Map)

37import Data.Map (Map)

33import qualified Data.Map as Map

38import qualified Data.Map as Map

34import Data.Text (Text)

39import Data.Text (Text)

35import qualified Data.Text.Encoding as T

40import qualified Data.Text.Encoding as T

36import Reflex

41import Reflex

37−import Reflex.Host.Class

42+import Reflex.Host.Class (MonadReflexCreateTrigger)

38−import Reflex.Dom

43+import Reflex.Dom.Core

44+ ( DomBuilder

45+ , DomRenderHook

46+ , HasDocument

47+ , HasJS

48+ , HasJSContext

49+ , Prerender (Client)

50+ , StaticDomBuilderT

51+ , prerender

52+ )

39#ifndef ghcjs_HOST_OS

53#ifndef ghcjs_HOST_OS

40import Language.Javascript.JSaddle (MonadJSM)

54import Language.Javascript.JSaddle (MonadJSM)

41#endif

55#endif

@@ -62,6 +76,8 @@ instance HasConfigs m => HasConfigs (PostBuildT t m)

62instance HasConfigs m => HasConfigs (QueryT t q m)

76instance HasConfigs m => HasConfigs (QueryT t q m)

63instance HasConfigs m => HasConfigs (ReaderT r m)

77instance HasConfigs m => HasConfigs (ReaderT r m)

64instance HasConfigs m => HasConfigs (RequesterT t request response m)

78instance HasConfigs m => HasConfigs (RequesterT t request response m)

79+instance HasConfigs m => HasConfigs (StateT w m)

80+instance HasConfigs m => HasConfigs (Strict.StateT w m)

65instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

81instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

66instance HasConfigs m => HasConfigs (TriggerEventT t m)

82instance HasConfigs m => HasConfigs (TriggerEventT t m)

67

83

@@ -72,12 +88,15 @@ newtype ConfigsT m a = ConfigsT { unConfigsT :: ReaderT (Map Text ByteString) m

72 , Monad

88 , Monad

73 , MonadPlus

89 , MonadPlus

74 , Alternative

90 , Alternative

91+ , MonadFail

75 , MonadFix

92 , MonadFix

93+ , MonadThrow

76 , MonadIO

94 , MonadIO

77 , MonadBase m'

95 , MonadBase m'

78 , MonadBaseControl m'

96 , MonadBaseControl m'

79 , MonadRef

97 , MonadRef

80 , MonadTrans

98 , MonadTrans

99+ , MFunctor

81 , DomBuilder t

100 , DomBuilder t

82 , MonadHold t

101 , MonadHold t

83 , MonadReflexCreateTrigger t

102 , MonadReflexCreateTrigger t

lib/frontend/obelisk-frontend.cabal+1−1

@@ -26,4 +26,4 @@ library

26 exposed-modules:

27 Obelisk.Frontend

28 Obelisk.Frontend.Cookie

29− ghc-options: -Wall

29+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/frontend/src/Obelisk/Frontend.hs+1−1

@@ -182,7 +182,7 @@ runFrontendWithConfigsAndCurrentRoute

182 -> Frontend (R frontendRoute)

183 -> JSM ()

184runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = do

185− let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

185+ let ve = validFullEncoder . hoistParse errorLeft (reviewEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

186 errorLeft = \case

187 Left _ -> error "runFrontend: Unexpected non-app ObeliskRoute reached the frontend. This shouldn't happen."

188 Right x -> Identity x

lib/route/README.mdnew file+6

@@ -0,0 +1,6 @@

1+# obelisk-route

2+

3+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org)

4+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://github.com/obsidiansystems/obelisk/blob/master/LICENSE)

5+

6+Robust URL management for single-page apps.

lib/route/obelisk-route.cabal+2−1

@@ -20,6 +20,7 @@ library

20 http-types,

21 jsaddle,

22 lens,

23+ mmorph,

23 monad-control,

24 monad-control,

24 mtl,

25 mtl,

25 network-uri,

26 network-uri,

@@ -38,4 +39,4 @@ library

38 exposed-modules: Obelisk.Route

39 exposed-modules: Obelisk.Route

39 Obelisk.Route.TH

40 Obelisk.Route.TH

40 Obelisk.Route.Frontend

41 Obelisk.Route.Frontend

41− ghc-options: -Wall -fwarn-redundant-constraints

42+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/route/src/Obelisk/Route.hs+98−52

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ApplicativeDo #-}

2{-# LANGUAGE ApplicativeDo #-}

2{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE EmptyCase #-}

4{-# LANGUAGE EmptyCase #-}

@@ -5,7 +6,6 @@

5{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE GADTs #-}

8{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE KindSignatures #-}

9{-# LANGUAGE LambdaCase #-}

10{-# LANGUAGE MultiParamTypeClasses #-}

11{-# LANGUAGE OverloadedStrings #-}

@@ -50,6 +50,7 @@ module Obelisk.Route

50 , pathParamEncoder

51 , pathLiteralEncoder

52 , singletonListEncoder

53+ , packTextEncoder

53 , unpackTextEncoder

54 , unpackTextEncoder

54 , prefixTextEncoder

55 , prefixTextEncoder

55 , unsafeTshowEncoder

56 , unsafeTshowEncoder

@@ -60,6 +61,7 @@ module Obelisk.Route

60 , justEncoder

61 , justEncoder

61 , nothingEncoder

62 , nothingEncoder

62 , isoEncoder

63 , isoEncoder

64+ , viewEncoder

63 , wrappedEncoder

65 , wrappedEncoder

64 , unwrappedEncoder

66 , unwrappedEncoder

65 , listToNonEmptyEncoder

67 , listToNonEmptyEncoder

@@ -68,6 +70,7 @@ module Obelisk.Route

68 , toListMapEncoder

70 , toListMapEncoder

69 , shadowEncoder

71 , shadowEncoder

70 , prismEncoder

72 , prismEncoder

73+ , reviewEncoder

71 , rPrism

74 , rPrism

72 , _R

75 , _R

73 , obeliskRouteEncoder

76 , obeliskRouteEncoder

@@ -132,20 +135,24 @@ import Control.Lens

132 , Prism'

135 , Prism'

133 , prism'

136 , prism'

134 , re

137 , re

138+ , review

135 , view

139 , view

136 , Wrapped (..)

140 , Wrapped (..)

137 )

141 )

138import Control.Monad.Except

142import Control.Monad.Except

139−import Control.Monad.Writer (execWriter, tell)

140import qualified Control.Monad.State.Strict as State

143import qualified Control.Monad.State.Strict as State

141import Control.Monad.Trans (lift)

144import Control.Monad.Trans (lift)

145+import Control.Monad.Writer (execWriter, tell)

146+import Data.Aeson (FromJSON, ToJSON)

147+import qualified Data.Aeson as Aeson

142import qualified Data.ByteString as BS

148import qualified Data.ByteString as BS

143import qualified Data.ByteString.Lazy as BSL

149import qualified Data.ByteString.Lazy as BSL

144−import Data.Dependent.Sum (DSum (..))

145import Data.Dependent.Map (DMap)

150import Data.Dependent.Map (DMap)

146import qualified Data.Dependent.Map as DMap

151import qualified Data.Dependent.Map as DMap

152+import Data.Dependent.Sum (DSum (..))

147import Data.Either.Validation (Validation (..))

153import Data.Either.Validation (Validation (..))

148import Data.Foldable

154import Data.Foldable

155+import Data.Functor (($>))

149import Data.Functor.Sum

156import Data.Functor.Sum

150import Data.GADT.Compare

157import Data.GADT.Compare

151import Data.GADT.Compare.TH

158import Data.GADT.Compare.TH

@@ -158,18 +165,18 @@ import Data.Monoid ((<>))

158import Data.Set (Set)

165import Data.Set (Set)

159import qualified Data.Set as Set

166import qualified Data.Set as Set

160import Data.Some (Some(Some))

167import Data.Some (Some(Some))

168+import Data.Tabulation

161import Data.Text (Text)

169import Data.Text (Text)

162import qualified Data.Text as T

170import qualified Data.Text as T

163import qualified Data.Text.Encoding as T

171import qualified Data.Text.Encoding as T

172+import Data.Text.Lens (IsText, packed, unpacked)

173+import Data.Type.Equality

164import Data.Universe

174import Data.Universe

165import Data.Universe.Some

175import Data.Universe.Some

166import Network.HTTP.Types.URI

176import Network.HTTP.Types.URI

167import qualified Numeric.Lens

177import qualified Numeric.Lens

168import Obelisk.Route.TH

178import Obelisk.Route.TH

169import Text.Read (readMaybe)

179import Text.Read (readMaybe)

170−import Data.Tabulation

171−import qualified Data.Aeson as Aeson

172−import Data.Aeson (FromJSON, ToJSON)

173

180

174-- Design goals:

181-- Design goals:

175-- No start-up time on the frontend (not yet met)

182-- No start-up time on the frontend (not yet met)

@@ -219,7 +226,19 @@ hoistR f (x :=> Identity y) = f x :/ y

219infixr 5 :.

226infixr 5 :.

220type (:.) = (,)

227type (:.) = (,)

221

228

229+#ifdef __GLASGOW_HASKELL__

230+#if __GLASGOW_HASKELL__ >= 810

222{-# COMPLETE (:.) #-}

231{-# COMPLETE (:.) #-}

232+#else

233+{-# WARNING (:.)

234+ [ "Use of this pattern in GHC < 8.10 will result in spurious non-exhaustive warnings at every use site."

235+ , "We cannot provide a COMPLETE pragma to silence these due to a GHC bug: https://gitlab.haskell.org/ghc/ghc/issues/17729."

236+ , "The bug hides incompleteness warnings for all two tuples when the COMPLETE pattern is in scope."

237+ , "Instead, you should use (,) directly until you can switch to GHC >= 8.10, where the COMPLETE pragma is reinstated."

238+ ]

239+ #-}

240+#endif

241+#endif

223pattern (:.) :: a -> b -> a :. b

242pattern (:.) :: a -> b -> a :. b

224pattern a :. b = (a, b)

243pattern a :. b = (a, b)

225

244

@@ -285,13 +304,13 @@ decode e x = runIdentity (tryDecode e x)

285-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the

304-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the

286-- parse monad, we may still attempt to decode with it in its parse monad.

305-- parse monad, we may still attempt to decode with it in its parse monad.

287tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded

306tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded

288−tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x

307+tryDecode (Encoder (Identity impl)) = _encoderImpl_decode impl

289

308

290-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it

309-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it

291-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,

310-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,

292-- one should usually be applying decode and encode to the same 'Encoder'

311-- one should usually be applying decode and encode to the same 'Encoder'

293encode :: Encoder Identity parse decoded encoded -> decoded -> encoded

312encode :: Encoder Identity parse decoded encoded -> decoded -> encoded

294−encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x

313+encode (Encoder (Identity impl)) = _encoderImpl_encode impl

295

314

296-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is

315-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is

297-- reasonably certain that the law given for 'EncoderImpl' above holds.

316-- reasonably certain that the law given for 'EncoderImpl' above holds.

@@ -338,7 +357,7 @@ instance Monad parse => Bifunctor (,) (EncoderImpl parse) (EncoderImpl parse) (E

338 }

357 }

339

358

340instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

359instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

341− braid = isoEncoder (iso swap swap)

360+ braid = viewEncoder (iso swap swap)

342

361

343

362

344instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

363instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

@@ -374,11 +393,11 @@ instance (Monad parse, Applicative check) => Bifunctor Either (Encoder check par

374 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

393 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

375

394

376instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

395instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

377− associate = isoEncoder (iso (associate @(->) @Either) disassociate)

396+ associate = viewEncoder (iso (associate @(->) @Either) disassociate)

378− disassociate = isoEncoder (iso disassociate associate)

397+ disassociate = viewEncoder (iso disassociate associate)

379

398

380instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

399instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

381− braid = isoEncoder (iso swap swap)

400+ braid = viewEncoder (iso swap swap)

382

401

383

402

384

403

@@ -432,17 +451,17 @@ instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,)

432--------------------------------------------------------------------------------

451--------------------------------------------------------------------------------

433

452

434-- | Given a valid 'Iso' from lens, construct an 'Encoder'

453-- | Given a valid 'Iso' from lens, construct an 'Encoder'

435−isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

454+viewEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

436−isoEncoder f = unsafeMkEncoder $ EncoderImpl

455+viewEncoder f = unsafeMkEncoder $ EncoderImpl

437 { _encoderImpl_encode = view f

456 { _encoderImpl_encode = view f

438 , _encoderImpl_decode = pure . view (from f)

457 , _encoderImpl_decode = pure . view (from f)

439 }

458 }

440

459

441wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

460wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

442−wrappedEncoder = isoEncoder $ from _Wrapped'

461+wrappedEncoder = viewEncoder $ from _Wrapped'

443

462

444unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

463unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

445−unwrappedEncoder = isoEncoder _Wrapped'

464+unwrappedEncoder = viewEncoder $ _Wrapped'

446

465

447maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

466maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

448maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

467maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

@@ -467,11 +486,11 @@ maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder

467

486

468-- | Encode a value by simply applying 'Just'

487-- | Encode a value by simply applying 'Just'

469justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

488justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

470−justEncoder = prismEncoder _Just

489+justEncoder = reviewEncoder _Just

471

490

472-- | Encode () to 'Nothing'.

491-- | Encode () to 'Nothing'.

473nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

492nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

474−nothingEncoder = prismEncoder _Nothing

493+nothingEncoder = reviewEncoder _Nothing

475

494

476someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

495someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

477someConstEncoder = unsafeMkEncoder $ EncoderImpl

496someConstEncoder = unsafeMkEncoder $ EncoderImpl

@@ -536,11 +555,11 @@ pathComponentEncoder f = Encoder $ do

536 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')

555 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')

537

556

538pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)

557pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)

539− => (Encoder check parse (Some p) (Maybe Text))

558+ => Encoder check parse (Some p) (Maybe Text)

540 -> (forall a. p a -> Encoder Identity parse a PageName)

559 -> (forall a. p a -> Encoder Identity parse a PageName)

541 -> Encoder check parse (R p) PageName

560 -> Encoder check parse (R p) PageName

542−pathComponentEncoderImpl this rest =

561+pathComponentEncoderImpl =

543− chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest

562+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder)

544

563

545--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction

564--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction

546

565

@@ -756,11 +775,11 @@ prefixNonemptyTextEncoder p = Encoder $ pure $ EncoderImpl

756 Just stripped -> pure stripped

775 Just stripped -> pure stripped

757 }

776 }

758

777

759−unpackTextEncoder :: (Applicative check, Applicative parse) => Encoder check parse Text String

778+packTextEncoder :: (Applicative check, Applicative parse, IsText text) => Encoder check parse String text

760−unpackTextEncoder = Encoder $ pure $ EncoderImpl

779+packTextEncoder = isoEncoder packed

761− { _encoderImpl_encode = T.unpack

780+

762− , _encoderImpl_decode = pure . T.pack

781+unpackTextEncoder :: (Applicative check, Applicative parse, IsText text) => Encoder check parse text String

763− }

782+unpackTextEncoder = isoEncoder unpacked

764

783

765toListMapEncoder :: (Applicative check, Applicative parse, Ord k) => Encoder check parse (Map k v) [(k, v)]

784toListMapEncoder :: (Applicative check, Applicative parse, Ord k) => Encoder check parse (Map k v) [(k, v)]

766toListMapEncoder = Encoder $ pure $ EncoderImpl

785toListMapEncoder = Encoder $ pure $ EncoderImpl

@@ -796,7 +815,7 @@ rPrism

796 :: forall f f'

815 :: forall f f'

797 . (forall a. Prism' (f a) (f' a))

816 . (forall a. Prism' (f a) (f' a))

798 -> Prism' (R f) (R f')

817 -> Prism' (R f) (R f')

799−rPrism p = dSumPrism p

818+rPrism = dSumPrism

800

819

801dSumPrism'

820dSumPrism'

802 :: forall f g a

821 :: forall f g a

@@ -808,7 +827,7 @@ dSumGEqPrism

808 :: GEq f

827 :: GEq f

809 => f a

828 => f a

810 -> Prism' (DSum f g) (g a)

829 -> Prism' (DSum f g) (g a)

811−dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (\x -> geq variant x)

830+dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (geq variant)

812

831

813-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual

832-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual

814-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'

833-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'

@@ -825,12 +844,19 @@ _R variant = dSumGEqPrism variant . iso runIdentity Identity

825

844

826-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

845-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

827-- if the prism doesn't match.

846-- if the prism doesn't match.

847+--

848+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@

849+-- (i.e. 'reviewEncoder' is a contravariant functor from the category of prisms to the category of encoders),

850+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might

851+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;

852+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their

853+-- reverse direction. In short @reviewEncoder (f . g) = reviewEncoder g . reviewEncoder f@.

828−prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

854+reviewEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

829−prismEncoder p = unsafeMkEncoder $ EncoderImpl

855+reviewEncoder p = unsafeMkEncoder $ EncoderImpl

830− { _encoderImpl_encode = (^. re p)

856+ { _encoderImpl_encode = review p

831 , _encoderImpl_decode = \r -> case r ^? p of

857 , _encoderImpl_decode = \r -> case r ^? p of

832 Just a -> pure a

858 Just a -> pure a

833− Nothing -> throwError "prismEncoder: value is not present in the prism"

859+ Nothing -> throwError "reviewEncoder: value is not present in the prism"

834 }

860 }

835

861

836-- | A URL path and query string, in which trailing slashes don't matter in the path

862-- | A URL path and query string, in which trailing slashes don't matter in the path

@@ -968,9 +994,9 @@ obeliskRouteSegment r appRouteSegment = case r of

968-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.

994-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.

969resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a

995resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a

970resourceRouteSegment = \case

996resourceRouteSegment = \case

971− ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoderIgnoringQuery

997+ ResourceRoute_Static -> PathSegment "static" pathOnlyEncoderIgnoringQuery

972− ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder

998+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" pathOnlyEncoder

973− ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder

999+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder

974 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty

1000 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty

975

1001

976data JSaddleWarpRoute :: * -> * where

1002data JSaddleWarpRoute :: * -> * where

@@ -982,7 +1008,7 @@ jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Enc

982jsaddleWarpRouteEncoder = pathComponentEncoder $ \case

1008jsaddleWarpRouteEncoder = pathComponentEncoder $ \case

983 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty

1009 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty

984 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty

1010 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty

985− JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder

1011+ JSaddleWarpRoute_Sync -> PathSegment "sync" pathOnlyEncoder

986

1012

987instance GShow appRoute => GShow (ObeliskRoute appRoute) where

1013instance GShow appRoute => GShow (ObeliskRoute appRoute) where

988 gshowsPrec prec = \case

1014 gshowsPrec prec = \case

@@ -1013,8 +1039,8 @@ someSumEncoder = Encoder $ pure $ EncoderImpl

1013

1039

1014data Void1 :: * -> * where {}

1040data Void1 :: * -> * where {}

1015

1041

1016−instance Universe (Some Void1) where

1042+instance UniverseSome Void1 where

1017− universe = []

1043+ universeSome = []

1018

1044

1019void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

1045void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

1020void1Encoder = Encoder $ pure $ EncoderImpl

1046void1Encoder = Encoder $ pure $ EncoderImpl

@@ -1026,17 +1052,6 @@ void1Encoder = Encoder $ pure $ EncoderImpl

1026instance GShow Void1 where

1052instance GShow Void1 where

1027 gshowsPrec _ = \case {}

1053 gshowsPrec _ = \case {}

1028

1054

1029−concat <$> mapM deriveRouteComponent

1030− [ ''ResourceRoute

1031− , ''JSaddleWarpRoute

1032− , ''IndexOnlyRoute

1033− ]

1034−

1035−makePrisms ''ObeliskRoute

1036−makePrisms ''FullRoute

1037−deriveGEq ''Void1

1038−deriveGCompare ''Void1

1039−

1040-- | Given a backend route and a checked route encoder, render the route (path

1055-- | Given a backend route and a checked route encoder, render the route (path

1041-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1056-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1042renderBackendRoute

1057renderBackendRoute

@@ -1069,11 +1084,11 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>

1069readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1084readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1070

1085

1071integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1086integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1072−integralEncoder = prismEncoder (Numeric.Lens.integral)

1087+integralEncoder = reviewEncoder Numeric.Lens.integral

1073

1088

1074pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1089pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1075 Encoder check parse (a, (as, b)) (as, b)

1090 Encoder check parse (a, (as, b)) (as, b)

1076−pathSegmentEncoder = first (prismEncoder _Cons) . disassociate

1091+pathSegmentEncoder = first (reviewEncoder _Cons) . disassociate

1077

1092

1078newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1093newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1079

1094

@@ -1144,7 +1159,7 @@ pathFieldEncoder fieldEncoder = unsafeEncoder $ do

1144 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)

1159 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)

1145 pure $ EncoderImpl

1160 pure $ EncoderImpl

1146 { _encoderImpl_encode = \(x, rest) -> execWriter $ do

1161 { _encoderImpl_encode = \(x, rest) -> execWriter $ do

1147− _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) *> pure x_i) x

1162+ _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) $> x_i) x

1148 tell rest

1163 tell rest

1149 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case

1164 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case

1150 [] -> throwError $ T.pack "not enough path components"

1165 [] -> throwError $ T.pack "not enough path components"

@@ -1180,3 +1195,34 @@ byteStringsToPageName p q =

1180 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1195 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1181

1196

1182--TODO: decodeURIComponent as appropriate

1197--TODO: decodeURIComponent as appropriate

1198+

1199+

1200+{-# DEPRECATED isoEncoder "Instead of 'isoEncoder f', use 'viewEncoder f'" #-}

1201+-- | Given a valid 'Iso' from lens, construct an 'Encoder'

1202+isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

1203+isoEncoder = viewEncoder

1204+

1205+{-# DEPRECATED prismEncoder "Instead of 'prismEncoder f', use 'reviewEncoder f'" #-}

1206+-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

1207+-- if the prism doesn't match.

1208+--

1209+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@

1210+-- (i.e. 'prismEncoder' is a contravariant functor from the category of prisms to the category of encoders),

1211+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might

1212+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;

1213+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their

1214+-- reverse direction. In short @prismEncoder (f . g) = prismEncoder g . prismEncoder f@.

1215+prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

1216+prismEncoder = reviewEncoder

1217+

1218+

1219+concat <$> mapM deriveRouteComponent

1220+ [ ''ResourceRoute

1221+ , ''JSaddleWarpRoute

1222+ , ''IndexOnlyRoute

1223+ ]

1224+

1225+makePrisms ''ObeliskRoute

1226+makePrisms ''FullRoute

1227+deriveGEq ''Void1

1228+deriveGCompare ''Void1

lib/route/src/Obelisk/Route/Frontend.hs+41−28

@@ -1,24 +1,24 @@

1−{-# LANGUAGE ApplicativeDo #-}

2{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

3−{-# LANGUAGE RecursiveDo #-}

2+{-# LANGUAGE ApplicativeDo #-}

4−{-# LANGUAGE StandaloneDeriving #-}

5{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE ConstraintKinds #-}

4+{-# LANGUAGE DataKinds #-}

6{-# LANGUAGE DefaultSignatures #-}

5{-# LANGUAGE DefaultSignatures #-}

7{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

8+{-# LANGUAGE FunctionalDependencies #-}

9{-# LANGUAGE GADTs #-}

10+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10{-# LANGUAGE LambdaCase #-}

11{-# LANGUAGE LambdaCase #-}

11{-# LANGUAGE OverloadedStrings #-}

12{-# LANGUAGE OverloadedStrings #-}

12{-# LANGUAGE PatternSynonyms #-}

13{-# LANGUAGE PatternSynonyms #-}

13{-# LANGUAGE RankNTypes #-}

14{-# LANGUAGE RankNTypes #-}

15+{-# LANGUAGE RecursiveDo #-}

14{-# LANGUAGE ScopedTypeVariables #-}

16{-# LANGUAGE ScopedTypeVariables #-}

17+{-# LANGUAGE StandaloneDeriving #-}

15{-# LANGUAGE TypeFamilies #-}

18{-# LANGUAGE TypeFamilies #-}

16{-# LANGUAGE TypeOperators #-}

19{-# LANGUAGE TypeOperators #-}

17−{-# LANGUAGE ViewPatterns #-}

18−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

19{-# LANGUAGE UndecidableInstances #-}

20{-# LANGUAGE UndecidableInstances #-}

20−{-# LANGUAGE DataKinds #-}

21+{-# LANGUAGE ViewPatterns #-}

21−{-# LANGUAGE FunctionalDependencies #-}

22

23module Obelisk.Route.Frontend

24 ( module Obelisk.Route

@@ -57,49 +57,42 @@ module Obelisk.Route.Frontend

57

58import Prelude hiding ((.), id)

59

60−import Obelisk.Route

61−

62import Control.Category (Category (..), (.))

60import Control.Category (Category (..), (.))

63import Control.Category.Cartesian ((&&&))

61import Control.Category.Cartesian ((&&&))

64import Control.Lens hiding (Bifunctor, bimap, universe, element)

62import Control.Lens hiding (Bifunctor, bimap, universe, element)

65import Control.Monad ((<=<))

63import Control.Monad ((<=<))

66import Control.Monad.Fix

64import Control.Monad.Fix

65+import Control.Monad.Morph

67import Control.Monad.Primitive

66import Control.Monad.Primitive

68import Control.Monad.Reader

67import Control.Monad.Reader

69import Control.Monad.Ref

68import Control.Monad.Ref

70import Control.Monad.Trans.Control

69import Control.Monad.Trans.Control

71import Data.Coerce

70import Data.Coerce

72import Data.Dependent.Sum (DSum (..))

71import Data.Dependent.Sum (DSum (..))

72+import Data.Functor.Compose

73+import Data.Functor.Misc

73import Data.GADT.Compare

74import Data.GADT.Compare

75+import qualified Data.List as L

74import Data.Map (Map)

76import Data.Map (Map)

77+import Data.Maybe (fromMaybe)

75import Data.Monoid

78import Data.Monoid

76import Data.Proxy

79import Data.Proxy

77import Data.Text (Text)

80import Data.Text (Text)

78import qualified Data.Text as T

81import qualified Data.Text as T

79−import Data.Functor.Compose

80−import Data.Functor.Misc

81−import Reflex.Class

82−import Reflex.Host.Class

83−import Reflex.PostBuild.Class

84−import Reflex.TriggerEvent.Class

85−import Reflex.PerformEvent.Class

86−import Reflex.EventWriter.Class

87−import Reflex.EventWriter.Base

88−import Reflex.Dynamic

89−import Reflex.Dom.Builder.Class

90import Data.Type.Coercion

82import Data.Type.Coercion

91−import Language.Javascript.JSaddle --TODO: Get rid of this - other platforms can also be routed

92−import Reflex.Dom.Core

93import qualified GHCJS.DOM as DOM

83import qualified GHCJS.DOM as DOM

94import qualified GHCJS.DOM.Types as DOM

84import qualified GHCJS.DOM.Types as DOM

95import qualified GHCJS.DOM.Window as Window

85import qualified GHCJS.DOM.Window as Window

86+import Language.Javascript.JSaddle (MonadJSM, jsNull, liftJSM) --TODO: Get rid of this - other platforms can also be routed

96import Network.URI

87import Network.URI

97−import Data.Maybe (fromMaybe)

88+import Reflex.Class

98−import qualified Data.List as L

89+import Reflex.Dom.Builder.Class

99−

90+import Reflex.Dom.Core

91+import Reflex.Host.Class

100import Unsafe.Coerce

92import Unsafe.Coerce

101

93

102import Obelisk.Configs

94import Obelisk.Configs

95+import Obelisk.Route

103

96

104infixr 5 :~

97infixr 5 :~

105pattern (:~) :: Reflex t => f a -> Dynamic t a -> DSum f (Compose (Dynamic t) Identity)

98pattern (:~) :: Reflex t => f a -> Dynamic t a -> DSum f (Compose (Dynamic t) Identity)

@@ -116,7 +109,23 @@ instance Monad m => Routed t r (RoutedT t r m) where

116instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)

109instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)

117

110

118newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

111newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

119− deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)

112+ deriving

113+ ( Functor

114+ , Applicative

115+ , Monad

116+ , MonadFix

117+ , MonadTrans

118+ , MFunctor

119+ , NotReady t

120+ , MonadHold t

121+ , MonadSample t

122+ , PostBuild t

123+ , TriggerEvent t

124+ , MonadIO

125+ , MonadReflexCreateTrigger t

126+ , HasDocument

127+ , DomRenderHook t

128+ )

120

129

121instance MonadReader r' m => MonadReader r' (RoutedT t r m) where

130instance MonadReader r' m => MonadReader r' (RoutedT t r m) where

122 ask = lift ask

131 ask = lift ask

@@ -192,6 +201,10 @@ instance (Monad m, RouteToUrl r m) => RouteToUrl r (EventWriterT t w m)

192

201

193instance (Monad m, SetRoute t r m) => SetRoute t r (EventWriterT t w m)

202instance (Monad m, SetRoute t r m) => SetRoute t r (EventWriterT t w m)

194

203

204+instance (Monad m, RouteToUrl r m) => RouteToUrl r (DynamicWriterT t w m)

205+

206+instance (Monad m, SetRoute t r m) => SetRoute t r (DynamicWriterT t w m)

207+

195runRoutedT :: RoutedT t r m a -> Dynamic t r -> m a

208runRoutedT :: RoutedT t r m a -> Dynamic t r -> m a

196runRoutedT = runReaderT . unRoutedT

209runRoutedT = runReaderT . unRoutedT

197

210

@@ -256,7 +269,7 @@ dynamicIdentityCoercion = unsafeCoerce (Coercion :: Coercion (Identity ()) ()) -

256factorRouted :: (Reflex t, MonadFix m, MonadHold t m, GEq f) => RoutedT t (DSum f (Dynamic t)) m a -> RoutedT t (DSum f Identity) m a

269factorRouted :: (Reflex t, MonadFix m, MonadHold t m, GEq f) => RoutedT t (DSum f (Dynamic t)) m a -> RoutedT t (DSum f Identity) m a

257factorRouted r = RoutedT $ ReaderT $ \d -> do

270factorRouted r = RoutedT $ ReaderT $ \d -> do

258 d' <- factorDyn d

271 d' <- factorDyn d

259− runRoutedT r $ (coerceWith (dynamicCoercion $ dsumValueCoercion dynamicIdentityCoercion) d')

272+ runRoutedT r $ coerceWith (dynamicCoercion $ dsumValueCoercion dynamicIdentityCoercion) d'

260

273

261maybeRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Maybe (Dynamic t a)) m b -> RoutedT t (Maybe a) m b

274maybeRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Maybe (Dynamic t a)) m b -> RoutedT t (Maybe a) m b

262maybeRouted r = RoutedT $ ReaderT $ \d -> do

275maybeRouted r = RoutedT $ ReaderT $ \d -> do

@@ -464,7 +477,7 @@ runRouteViewT

464 , MonadJSM (Performable m)

477 , MonadJSM (Performable m)

465 , MonadFix m

478 , MonadFix m

466 )

479 )

467− => (Encoder Identity Identity r PageName)

480+ => Encoder Identity Identity r PageName

468 --TODO: Get rid of the switchover and useHash arguments

481 --TODO: Get rid of the switchover and useHash arguments

469 -- useHash can probably be baked into the encoder

482 -- useHash can probably be baked into the encoder

470 -> Event t () -- ^ Switchover event, nothing is done until this event fires. Used to prevent incorrect DOM expectations at hydration switchover time

483 -> Event t () -- ^ Switchover event, nothing is done until this event fires. Used to prevent incorrect DOM expectations at hydration switchover time

lib/run/obelisk-run.cabal+2−2

@@ -33,7 +33,7 @@ library

33 , process

34 , ref-tf

35 , reflex

36− , reflex-dom

36+ , reflex-dom-core

37 , snap-core

38 , streaming-commons

39 , text

@@ -47,7 +47,7 @@ library

47 , websockets

48 exposed-modules:

49 Obelisk.Run

50− ghc-options: -Wall -fwarn-redundant-constraints

50+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

51 if os(linux)

52 cpp-options: -DIPROUTE_SUPPORTED

53 build-depends: which

lib/run/src/Obelisk/Run.hs+3−3

@@ -144,9 +144,9 @@ runWidget conf configs frontend validFullEncoder = do

144

145 cert <- X509.newX509 >>= X509Request.makeX509FromReq certRequest

146 _ <- X509.setPublicKey cert privateKey

147− now <- getCurrentTime

147+ timenow <- getCurrentTime

148− _ <- X509.setNotBefore cert $ addUTCTime (-1) now

148+ _ <- X509.setNotBefore cert $ addUTCTime (-1) timenow

149− _ <- X509.setNotAfter cert $ addUTCTime (365 * 24 * 60 * 60) now

149+ _ <- X509.setNotAfter cert $ addUTCTime (365 * 24 * 60 * 60) timenow

150 _ <- X509.signX509 cert privateKey Nothing

151

152 certByteString <- BSUTF8.fromString <$> PEM.writeX509 cert

lib/selftest/src/Obelisk/SelfTest.hs+25−7

@@ -19,6 +19,7 @@ import Data.Bool (bool)

19import qualified Data.ByteString.Lazy as LBS

20import Data.Foldable (for_)

21import Data.Function (fix)

22+import Data.List (isInfixOf)

22import qualified Data.Map as Map

23import qualified Data.Map as Map

23import Data.Semigroup ((<>))

24import Data.Semigroup ((<>))

24import qualified Data.Set as Set

25import qualified Data.Set as Set

@@ -205,6 +206,22 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

205 it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager

206 it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager

206 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

207 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

207

208

209+ describe "ob repl" $ do

210+ it "accepts stdin commands" $ inTmpObInit $ \_ -> do

211+ setStdin "print 3\n:q"

212+ output <- runOb ["repl"]

213+ liftIO $ assertBool "" $

214+ [ "*Obelisk.Run Obelisk.Run Frontend Backend> 3"

215+ , "*Obelisk.Run Obelisk.Run Frontend Backend> Leaving GHCi."

216+ ] `isInfixOf` T.lines (T.strip output)

217+ it "works with custom Prelude" $ inTmpObInit $ \_ -> do

218+ writefile "common/src/Prelude.hs"

219+ "{-# LANGUAGE PackageImports #-} module Prelude (module X) where import \"base\" Prelude as X"

220+ setStdin ":q"

221+ output <- runOb ["repl"]

222+ liftIO $ assertBool "" $

223+ "*Obelisk.Run Obelisk.Run Frontend Backend> Leaving GHCi." `T.isInfixOf` output

224+

208 describe "obelisk project" $ parallel $ do

225 describe "obelisk project" $ parallel $ do

209 it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]

226 it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]

210 it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]

227 it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]

@@ -243,6 +260,8 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

243 uu <- update

260 uu <- update

244 assertRevEQ u uu

261 assertRevEQ u uu

245

262

263+ it "can run 'ob doc'" $ inTmpObInit $ \_ -> runOb_ ["doc", "reflex"]

264+

246 describe "ob thunk pack/unpack" $ parallel $ do

265 describe "ob thunk pack/unpack" $ parallel $ do

247 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

266 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

248

267

@@ -304,6 +323,11 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

304 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

323 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

305 checkDir dir >>= liftIO . assertEqual "" startingContents

324 checkDir dir >>= liftIO . assertEqual "" startingContents

306

325

326+ describe "ob shell" $ parallel $ do

327+ it "works with --" $ inTmpObInit $ \_ -> do

328+ output <- runOb ["shell", "--", "ghc-pkg", "list"]

329+ liftIO $ assertBool "Unexpected output from ob shell" $ ("Cabal-" `T.isInfixOf` output) && ("ghc-" `T.isInfixOf` output)

330+

307 describe "ob hoogle" $ {- NOT parallel -} do

331 describe "ob hoogle" $ {- NOT parallel -} do

308 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

332 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

309 [p0] <- liftIO $ getFreePorts 1

333 [p0] <- liftIO $ getFreePorts 1

@@ -336,7 +360,6 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

336 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

360 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

337 () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"

361 () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"

338 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

362 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

339− runOb_ ["thunk", "init", toTextIgnore obeliskImpl]

340 f obeliskImpl

363 f obeliskImpl

341

364

342 withInitCache f =

365 withInitCache f =

@@ -498,14 +521,9 @@ testLegacyGitThunks isVerbose = withSystemTempDirectory "test-git-repo" $ \gitDi

498

521

499 for_ (legacyGitThunks (GitThunkParams gitDir rev sha256)) $ \mkFiles ->

522 for_ (legacyGitThunks (GitThunkParams gitDir rev sha256)) $ \mkFiles ->

500 withSystemTempDirectory "test-thunks" $ \thunkDir -> do

523 withSystemTempDirectory "test-thunks" $ \thunkDir -> do

501− let nixEval = run nixInstantiatePath ["--eval", toTextIgnore (thunkDir </> ("thunk.nix" :: FilePath))]

502 liftIO $ mkFiles thunkDir

524 liftIO $ mkFiles thunkDir

503 run_ "ob" ["thunk", "unpack", toTextIgnore thunkDir]

525 run_ "ob" ["thunk", "unpack", toTextIgnore thunkDir]

504− unpackedEval <- nixEval

505 run_ "ob" ["thunk", "pack", toTextIgnore thunkDir]

526 run_ "ob" ["thunk", "pack", toTextIgnore thunkDir]

506− packedEval <- nixEval

507− liftIO $ assertBool "Unpacked and packed thunk.nix should not eval to the same thing" $

508− unpackedEval /= packedEval

509

527

510data GitThunkParams = GitThunkParams

528data GitThunkParams = GitThunkParams

511 { _gitThunkParams_repo :: !FilePath

529 { _gitThunkParams_repo :: !FilePath

@@ -605,4 +623,4 @@ legacyGitThunks (GitThunkParams repo' rev sha256) =

605 LBS.writeFile (dir </> ("git.json" :: FilePath)) (Aeson.encode gitJson)

623 LBS.writeFile (dir </> ("git.json" :: FilePath)) (Aeson.encode gitJson)

606

624

607unpackedDirName :: FilePath

625unpackedDirName :: FilePath

608−unpackedDirName = "local"

626+unpackedDirName = "."

lib/snap-extras/obelisk-snap-extras.cabal+1−2

@@ -12,10 +12,9 @@ library

12 , base

13 , bytestring

14 , snap-core

15− , unix

16 , directory

15 , directory

17 , filepath

16 , filepath

18 , text

17 , text

19 exposed-modules:

18 exposed-modules:

20 Obelisk.Snap.Extras

19 Obelisk.Snap.Extras

21− ghc-options: -Wall

20+ ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

lib/snap-extras/src/Obelisk/Snap/Extras.hs+1−1

@@ -17,7 +17,7 @@ import System.Directory

17-- | Set response header for "permanent" caching

18cachePermanently :: MonadSnap m => m ()

19cachePermanently = do

20− modifyResponse $ setHeader "Cache-Control" "public, max-age=315360000"

20+ modifyResponse $ setHeader "Cache-Control" "public, max-age=315360000, immutable"

21 modifyResponse $ setHeader "Expires" "Tue, 01 Feb 2050 00:00:00 GMT" --TODO: This should be set to "approximately one year from the time the response is sent"

22

23-- | Set response header to not cache

scripts/ghcid-this-libdeleted−4

@@ -1,4 +0,0 @@

1−#!/usr/bin/env bash

2−set -euo pipefail

3−

4−nix-shell -E "with (import ../.. {}); reflex-platform.workOn haskellPackageSets.ghc haskellPackageSets.ghc.obelisk-$(basename $PWD)" --run "ghcid -c 'cabal new-repl'"

skeleton/.gitignore+12−6

@@ -1,9 +1,15 @@

1−dist-newstyle

2−result

3−result-*

4−result-android

5−result-ios

6−result-exe

7.attr-cache

1.attr-cache

2+.cabal-sandbox

3+*.hi

4+*.o

5+cabal.project.local

6+cabal.sandbox.config

7+ctags

8+dist-newstyle/

9+dist/

8ghcid-output.txt

10ghcid-output.txt

9profile/

11profile/

12+result

13+result-*

14+tags

15+TAGS

skeleton/backend/backend.cabal+2−1

@@ -14,11 +14,12 @@ library

14 , obelisk-route

15 exposed-modules:

16 Backend

17− ghc-options: -Wall

17+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

18

19executable backend

20 main-is: main.hs

21 hs-source-dirs: src-bin

22+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -threaded -fno-show-valid-hole-fits

22 if impl(ghcjs)

23 if impl(ghcjs)

23 buildable: False

24 buildable: False

24 build-depends: base

25 build-depends: base

skeleton/cabal.project+1

@@ -1,2 +1,3 @@

1optional-packages:

2 *

3+write-ghc-environment-files: never

skeleton/common/common.cabal+1

@@ -12,3 +12,4 @@ library

12 exposed-modules:

13 Common.Api

14 Common.Route

15+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

skeleton/default.nix+11−6

@@ -1,18 +1,23 @@

1−{ obelisk ? import ./.obelisk/impl {

2− system = builtins.currentSystem;

1+{ system ? builtins.currentSystem

2+, obelisk ? import ./.obelisk/impl {

3+ inherit system;

3− iosSdkVersion = "10.2";

4+ iosSdkVersion = "13.2";

5+

4 # You must accept the Android Software Development Kit License Agreement at

6 # You must accept the Android Software Development Kit License Agreement at

5 # https://developer.android.com/studio/terms in order to build Android apps.

7 # https://developer.android.com/studio/terms in order to build Android apps.

6 # Uncomment and set this to `true` to indicate your acceptance:

8 # Uncomment and set this to `true` to indicate your acceptance:

7 # config.android_sdk.accept_license = false;

9 # config.android_sdk.accept_license = false;

10+

11+ # In order to use Let's Encrypt for HTTPS deployments you must accept

12+ # their terms of service at https://letsencrypt.org/repository/.

13+ # Uncomment and set this to `true` to indicate your acceptance:

14+ # terms.security.acme.acceptTerms = false;

8 }

15 }

9}:

16}:

10with obelisk;

17with obelisk;

11−project ./. ({ pkgs, ... }: {

18+project ./. ({ ... }: {

12 android.applicationId = "systems.obsidian.obelisk.examples.minimal";

19 android.applicationId = "systems.obsidian.obelisk.examples.minimal";

13 android.displayName = "Obelisk Minimal Example";

20 android.displayName = "Obelisk Minimal Example";

14 ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";

21 ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";

15 ios.bundleName = "Obelisk Minimal Example";

22 ios.bundleName = "Obelisk Minimal Example";

16−

17− __withGhcide = true;

18})

23})

skeleton/frontend/frontend.cabal+6−4

@@ -16,7 +16,7 @@ library

16 , text

17 exposed-modules:

18 Frontend

19− ghc-options: -Wall

19+ ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

20

21executable frontend

22 main-is: main.hs

@@ -28,7 +28,9 @@ executable frontend

28 , reflex-dom

29 , obelisk-generated-static

30 , frontend

31− --TODO: Make these ghc-options optional

31+ ghc-options: -threaded -O -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -fno-show-valid-hole-fits

32− ghc-options: -threaded

32+ if impl(ghcjs)

33+ ghc-options: -dedupe

34+ cpp-options: -DGHCJS_BROWSER

33 if os(darwin)

35 if os(darwin)

34− ghc-options: -dynamic

36+ ghc-options: -dynamic

skeleton/hie-bios.shdeleted−3

@@ -1,3 +0,0 @@

1−#!/usr/bin/env bash

2−. $HOME/.bash_profile;

3−ob internal export-ghci-configuration > "$HIE_BIOS_OUTPUT"

skeleton/hie.yamldeleted−1

@@ -1 +0,0 @@

1−cradle: { bios: { program: hie-bios.sh } }

skeleton/shell.nixdeleted−1

@@ -1 +0,0 @@

1−(import ./. {}).shells.ghc