master..73e78ee · obelisk

.github/pull_request_template.md−2

since splitsnapshots

unifiedsplit

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

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)

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

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

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

7 - [ ] 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)

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

8 - [ ] (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,7 +8,6 @@ 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)

12

11

13## Opening Issues

12## Opening Issues

14

13

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

40

39

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

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

42

41

43−

44### Code Quality

42### Code Quality

45

43

46#### Warnings

44#### Warnings

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

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

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

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.

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.

81

79

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+21−32

@@ -2,50 +2,39 @@

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−## v0.9.1.0

5+## Unreleased

6

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

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:

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

14

8

9+ Packed thunks look like

15

10

16−## v0.9.0.1

11+ my-thunk/

12+ ├── default.nix

13+ ├── thunk.nix

14+ └── github.json

17

15

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

16+ and unpacked thunks look like

19

17

20−## v0.9.0.0

18+ my-thunk/

19+ ├── default.nix

20+ ├── thunk.nix

21+ └── local

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

21

23

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.

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

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.

34

25

35−## v0.8.0.0

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.

36

27

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.

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.

29+

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

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.

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.

39

32

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.

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.

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.

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.

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`.

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`.

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`.

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.

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`.

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.

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

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

49

38

50## v0.7.0.1

39## v0.7.0.1

51

40

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

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 error messaging when a dependency doesn't have the expected `.cabal` or `package.yaml` file. ([#597](https://github.com/obsidiansystems/obelisk/pull/597))

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

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

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

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

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+* 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))

96

85

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

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

98

87

FAQ.md+67−62

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

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)

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

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

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

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

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

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

10−

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

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−

64

7

65### How do I fix invalid entitlements?

8### How do I fix invalid entitlements?

66

9

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

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

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

68

12

69```

13```

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)

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)

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

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

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

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

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

77

21

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:

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:

79

23

80```

24```

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

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

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

95

39

96And here's how you can fix it:

40And here's how you can fix it:

97

41

98−```bash

42+```

99ob thunk unpack $SOME_THUNK

43ob thunk unpack $SOME_THUNK

100ob thunk pack $SOME_THUNK

44ob thunk pack $SOME_THUNK

101```

45```

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

115```

59```

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

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

117`import "cryptonite" Crypto.Hash`

61`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+129−71

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

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://github.com/obsidiansystems/obelisk/blob/master/LICENSE)

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

5

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

7

6

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.

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.

9

8

10−- [Overview](#overview)

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

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

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

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

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

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

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

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

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

15- [Deploying](#deploying)

14- [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)

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

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

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

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

22- [Mobile](#mobile)

21- [Mobile](#mobile)

23 - [iOS](#ios)

22 - [iOS](#ios)

24 - [Android](#android)

23 - [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−

38

24

39## Installing Obelisk

25## Installing Obelisk

40−

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

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

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`.

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`.

431. Set up nix caches

281. Set up nix caches

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

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

45− ```nix

30+ ```

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

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

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

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

48 ```

33 ```

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

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

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)):

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)):

51− ```nix

36+ ```

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

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

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

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

54− binary-caches-parallel-connections = 40

39+ binary-caches-parallel-connections = 40

55 ```

40 ```

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:

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)

57− ```nix

42+ ```

58 sandbox = true

43 sandbox = true

59 ```

44 ```

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

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

61− ```nix

46+ ```

62 sandbox = false

47 sandbox = false

63 ```

48 ```

64 then restart the nix daemon

49 then restart the nix daemon

65− ```bash

50+ ```

66 sudo launchctl stop org.nixos.nix-daemon

51 sudo launchctl stop org.nixos.nix-daemon

67 sudo launchctl start org.nixos.nix-daemon

52 sudo launchctl start org.nixos.nix-daemon

68 ```

53 ```

69−1. Install obelisk:

70− ```bash

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

54+1. Install obelisk: `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"

72− ```

90+```

73

91

74### Accessing private repositories

92### Accessing private repositories

75

93

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

99

117

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.

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.

101

119

102−### IDE Support

120+### Adding packages

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+```

103

169

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

170+### Running over HTTPS

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.

105

175

106## Deploying

176## Deploying

107

177

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+

108### Default EC2 Deployment

195### Default EC2 Deployment

109

196

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)).

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)).

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

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))

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))

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

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

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

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

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.

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.

118

205

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

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

120

207

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

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

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.

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.

123

210

124−```bash

211+```

125cd ~/code/myapp

212cd ~/code/myapp

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

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

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

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

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

140

227

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

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

142

229

143−```bash

230+```

144cd ~/code/myapp-deploy

231cd ~/code/myapp-deploy

145ob deploy push

232ob deploy push

146```

233```

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

169

256

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

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

171

258

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−

191### From macOS

259### From macOS

192

260

193Deploying from macOS requires some extra setup:

261Deploying from macOS requires some extra setup:

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

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

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

222

290

223##### Xcode

291##### Xcode

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

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

225

293

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`

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`

227

295

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

314##### Build a release version

382##### Build a release version

315

383

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.

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.

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.nixdeleted−430

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

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+6−15

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

1{ self-args ? {

2 config.android_sdk.accept_license = true;

3− iosSdkVersion = "13.2";

3+ iosSdkVersion = "10.2";

4 }

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

6, supportedSystems ? [ builtins.currentSystem ]

@@ -53,28 +53,19 @@ 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;

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

56+ skeleton = 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−

66− serverSkeletonExe = rawSkeleton.exe;

57+ serverSkeletonExe = skeleton.exe;

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

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

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

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

69 touch "$out"

60 touch "$out"

70 echo "return" >> "$out"

61 echo "return" >> "$out"

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

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

72 '';

63 '';

73− androidSkeleton = skeleton.android.frontend;

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

74− iosSkeleton = skeleton.ios.frontend;

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

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

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

76 packages = {

67 packages = {

77− skeletonProfiledObRun = rawSkeleton.__unstable__.profiledObRun;

68+ skeletonProfiledObRun = skeleton.__unstable__.profiledObRun;

78 inherit

69 inherit

79 command

70 command

80 serverSkeletonShell

71 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 && git checkout -b bad")

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

129 client.succeed(

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

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

131 )

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

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

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

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

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

134+ client.succeed("cd ~/code/myapp/local && 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 && git checkout master")

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

139

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

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

default.nix+29−71

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

1{ system ? builtins.currentSystem

2, profiling ? false

3−, iosSdkVersion ? "13.2"

3+, iosSdkVersion ? "10.2"

4, config ? {}

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

6− security.acme.acceptTerms = false;

7− }

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

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

9}:

6}:

10let

7let

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

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

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

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

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

48 obelisk = ghcObelisk;

45 obelisk = ghcObelisk;

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

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

50 command = ghcObelisk.obelisk-command;

47 command = ghcObelisk.obelisk-command;

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

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

52

49

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

77 '';

74 '';

78

75

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

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

80− set -euo pipefail

77+ mkdir $out

78+ cd $out

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

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

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

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"

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

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

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

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

89− '' else ''

83+ '' else ''

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"

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

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

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

92− ''}

86+ ''}

93− done

94 '';

87 '';

95

88

96 serverModules = {

89 serverModules = {

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

116 security.acme.certs = if enableHttps then {

109 security.acme.certs = if enableHttps then {

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

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

118 } else {};

111 } else {};

119−

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

121 };

112 };

122

113

123 mkObeliskApp =

114 mkObeliskApp =

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

134 }: {...}: {

125 }: {...}: {

135 services.nginx = {

126 services.nginx = {

136 enable = true;

127 enable = true;

137− recommendedProxySettings = true;

138 virtualHosts."${routeHost}" = {

128 virtualHosts."${routeHost}" = {

139 enableACME = enableHttps;

129 enableACME = enableHttps;

140 forceSSL = enableHttps;

130 forceSSL = enableHttps;

141 locations.${baseUrl} = {

131 locations.${baseUrl} = {

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

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

143 proxyWebsockets = true;

133 proxyWebsockets = true;

144− extraConfig = ''

145− access_log off;

146− '';

147 };

134 };

148 };

135 };

149 };

136 };

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

184 pkgs.runCommand "serverExe" {} ''

171 pkgs.runCommand "serverExe" {} ''

185 mkdir $out

172 mkdir $out

186 set -eux

173 set -eux

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

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

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

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

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

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

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

191− done

192 echo ${version} > $out/version

177 echo ${version} > $out/version

193 '';

178 '';

194

179

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

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

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

203 (serverModules.mkDefaultNetworking args)

188 (serverModules.mkDefaultNetworking args)

204 (serverModules.mkObeliskApp args)

189 (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− })

219 ];

190 ];

220 };

191 };

221 };

192 };

@@ -236,14 +207,13 @@ in rec {

236 , shellToolOverrides ? _: _: {}

207 , shellToolOverrides ? _: _: {}

237 , withHoogle ? false # Setting this to `true` makes shell reloading far slower

208 , withHoogle ? false # Setting this to `true` makes shell reloading far slower

238 , __closureCompilerOptimizationLevel ? "ADVANCED" # Set this to `null` to skip the closure-compiler step

209 , __closureCompilerOptimizationLevel ? "ADVANCED" # Set this to `null` to skip the closure-compiler step

239− , __withGhcide ? false

240 }:

210 }:

241 let

211 let

242 allConfig = nixpkgs.lib.makeExtensible (self: {

212 allConfig = nixpkgs.lib.makeExtensible (self: {

243 base = base';

213 base = base';

244 inherit args;

214 inherit args;

245 userSettings = {

215 userSettings = {

246− inherit android ios packages overrides tools shellToolOverrides withHoogle __closureCompilerOptimizationLevel __withGhcide;

216+ inherit android ios packages overrides tools shellToolOverrides withHoogle __closureCompilerOptimizationLevel;

247 staticFiles = if staticFiles == null then self.base + /static else staticFiles;

217 staticFiles = if staticFiles == null then self.base + /static else staticFiles;

248 };

218 };

249 frontendName = "frontend";

219 frontendName = "frontend";

@@ -300,17 +270,9 @@ in rec {

300 self.frontendName

270 self.frontendName

301 ];

271 ];

302

272

303− shellToolOverrides = lib.composeExtensions

304− self.userSettings.shellToolOverrides

305− (if self.userSettings.__withGhcide

306− then (import ./haskell-overlays/ghcide.nix)

307− else (_: _: {})

308− );

309−

310 project = reflexPlatformProject ({...}: self.projectConfig);

273 project = reflexPlatformProject ({...}: self.projectConfig);

311 projectConfig = {

274 projectConfig = {

312− inherit (self) shellToolOverrides;

313− inherit (self.userSettings) tools withHoogle;

275+ inherit (self.userSettings) shellToolOverrides tools withHoogle;

314 overrides = self.totalOverrides;

276 overrides = self.totalOverrides;

315 packages = self.combinedPackages;

277 packages = self.combinedPackages;

316 shells = {

278 shells = {

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

350 __unstable__.profiledObRun = let

312 __unstable__.profiledObRun = let

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

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

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

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

353− {-# LANGUAGE NoImplicitPrelude #-}

354− {-# LANGUAGE PackageImports #-}

355 module Main where

315 module Main where

356

316

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

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

359−

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

317+ import Control.Exception

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

318+ import Reflex.Profiled

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

319+ import System.Environment

363

320

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

321+ import qualified Obelisk.Run

365 import qualified Frontend

322 import qualified Frontend

366 import qualified Backend

323 import qualified Backend

367

324

368 main :: IO ()

325 main :: IO ()

369 main = do

326 main = do

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

327+ args <- getArgs

328+ let port = read $ args !! 0

329+ assets = args !! 1

330+ profileFile = (args !! 2) <> ".rprof"

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

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

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

373 '';

332 '';

374 in nixpkgs.runCommand "ob-run" {

333 in nixpkgs.runCommand "ob-run" {

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

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

376 } ''

335 } ''

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

378− mkdir -p $out/bin

336+ mkdir -p $out/bin/

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

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

380 '';

338 '';

381

339

382 linuxExeConfigurable = linuxExe;

340 linuxExeConfigurable = linuxExe;

dep/.gitignorenew file+5

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

1+*

2+!*/

3+!.gitignore

4+!*/*.json

5+!*/default.nix

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

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

1# DO NOT HAND-EDIT THIS FILE

2−import (import ./thunk.nix)

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+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": "release/0.7.0.0",

4+ "branch": "master",

5 "private": false,

6− "rev": "27a7851a780ff21472d85f9a02fb84635ef9027a",

6+ "rev": "41be4d952b75515a037318aa344dd6b13ad29cfe",

7− "sha256": "1m4zlw91dpjlbdchjyxhvhv3k7lilm0qa17dhhww868xxc27sann"

7+ "sha256": "132yqzyzd3c5fjy7wwnwa5d6pjxv5ap2xz0swwbv3h5pwi8jwv0a"

8−}

8+}

dep/reflex-platform/thunk.nixdeleted−9

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

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.pngdeleted

Binary file not shown.

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

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

1# Obelisk Application Deployment Guide

2−

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.

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.

4

3

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.

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.

6>

5>

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.

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.

8

7

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

8+## a) Get Obelisk

10

9

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.

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.

12

11

13Open a terminal and run the following:

12Open a terminal and run the following:

14

13

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

40

39

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.

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.

42

41

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

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

44

43

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

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

46

45

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

53

52

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

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

55

54

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

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

57

56

58### Import the NixOS VirtualBox appliance

57### Import the NixOS VirtualBox appliance

59−

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

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

61

59

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

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

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

81

79

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

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

83

81

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".

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".

85

83

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

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

87

85

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

203git push -u origin master

201git push -u origin master

204```

202```

205

203

206−### Initialize deployment directory

204+### Deploy

207

205

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

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

209

207

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

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

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

219```

217```

220

218

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

219+And deploy:

222−

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

224−

225−Now we can deploy to the VirtualBox VM.

226

220

227```bash

221```bash

228cd "$WORKDIR/myappdeploy"

222cd "$WORKDIR/myappdeploy"

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

249

243

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

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

251

245

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

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

253

247

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

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

255

249

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

263git push

257git push

264```

258```

265

259

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.

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.

267

261

268Now update your deployment and deploy to Android:

262Now update your deployment and deploy to Android:

269

263

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

273ob deploy test android -v

267ob deploy test android -v

274```

268```

275

269

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−

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.

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.

284

271

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

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

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

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

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

292

279

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

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

294

281

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

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

296

283

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

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

298

285

haskell-overlays/ghcide.nixdeleted−40

@@ -1,40 +0,0 @@

1−self: super:

2−let

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

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

5− inherit (pkgs.haskellPackages) callHackageDirect callHackage;

6−

7−in {

8− ghcide = justStaticExecutables (dontCheck (callHackageDirect {

9− pkg = "ghcide";

10− ver = "0.2.0";

11− sha256 = "199l4qzrghhz6wbfkgqdl4gll4wvgpr190kinzhv88idnn9pxm96";

12− } rec {

13− ghc-check = callHackageDirect {

14− pkg = "ghc-check";

15− ver = "0.3.0.1";

16− sha256 = "1dj909m09m24315x51vxvcl28936ahsw4mavbc53danif3wy09ns";

17− } { };

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

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

20− haskell-lsp = dontCheck (callHackageDirect {

21− pkg = "haskell-lsp";

22− ver = "0.22.0.0";

23− sha256 = "1q3w46qcvzraxgmw75s7bl0qvb2fvff242r5vfx95sqska566b4m";

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

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

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

27− ver = "0.22.0.0";

28− sha256 = "1apjclphi2v6ggrdnbc0azxbb1gkfj3x1vkwpc8qd6lsrbyaf0n8";

29− } { });

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

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

32− });

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

34− hie-bios = dontCheck (callHackageDirect {

35− pkg = "hie-bios";

36− ver = "0.5.0";

37− sha256 = "116nmpva5jmlgc2dgy8cm5wv6cinhzmga1l0432p305074w720r2";

38− } { });

39− }));

40−}

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

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

9in

10

11{

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

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

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" {});

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

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

18−

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

20

14

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

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

22 # Exports more internals

16 # Exports more internals

haskell-overlays/obelisk.nix−5

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

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

20 librarySystemDepends = [

21 pkgs.jre

22− pkgs.git

23 pkgs.nix

22 pkgs.nix

24− pkgs.nix-prefetch-git

25− pkgs.openssh

26− pkgs.rsync

27− pkgs.which

28 (haskellLib.justStaticExecutables self.ghcid)

23 (haskellLib.justStaticExecutables self.ghcid)

29 ];

24 ];

30 };

25 };

lib/asset/README.md+19−16

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

1−# obelisk-asset

1+## obelisk-asset

2

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

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

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

5−

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

7−

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)

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

9−

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

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

10−```nix

7+```

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

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

9+}:

12```

10```

13

11

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.

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

15−

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

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

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

17

15

18−```nix

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

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

18+```

19myAssets = assets.mkAssets ./static;

20```

21

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.

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

23−

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

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.

24```bash

27```bash

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

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

26```

29```

lib/asset/assets.nix+5−28

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

20 nixpkgs.stdenv.mkDerivation {

21 name = "encodings";

22

23− input = mkPath file;

23+ input = 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 = mkPath file;

49+ input = 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 = mkPath file;

73+ input = 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− path = mkPath path;

206+ inherit path;

207 } ''

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

209 '');

@@ -224,30 +224,7 @@ 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−

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

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

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

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

252mkAsset = encodings: {name, value}:

229mkAsset = encodings: {name, value}:

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

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

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

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

24 , template-haskell

25 , text

26 , transformers

27− , unix-compat

27+ , unix

28 , vector

29 exposed-modules:

30 Obelisk.Asset.Gather

@@ -33,9 +33,7 @@ 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

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

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

39

37

40executable obelisk-asset-manifest-generate

38executable obelisk-asset-manifest-generate

41 hs-source-dirs: src-bin

39 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.PosixCompat.Files

10+import System.Posix.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+2−4

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

23 , obelisk-snap-extras

24 , text

25 , transformers

26− , unix-compat

26+ , unix

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

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

32+ ghc-options: -Wall -Werror -fno-warn-unused-do-bind -fwarn-tabs -funbox-strict-fields -O2 -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.PosixCompat.Files (getFileStatus, fileSize)

34+import System.Posix (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-core,

24+ reflex-dom,

25 snap,

26 snap-server,

27 text,

28 universe

29 exposed-modules: Obelisk.Backend

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

30+ ghc-options: -Wall

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.Core

61+import Reflex.Dom

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

63 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText

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

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

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

19 , monad-loops

20 , mtl

21 , process

22− , shell-escape

23 , terminal-size

22 , terminal-size

24 , text

23 , text

25 , time

24 , time

26 , transformers

25 , transformers

27− , utf8-string

28 exposed-modules:

26 exposed-modules:

29 Obelisk.CliApp

27 Obelisk.CliApp

30 other-modules:

28 other-modules:

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

34 Obelisk.CliApp.TerminalString

32 Obelisk.CliApp.TerminalString

35 Obelisk.CliApp.Theme

33 Obelisk.CliApp.Theme

36 Obelisk.CliApp.Types

34 Obelisk.CliApp.Types

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

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

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

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

39 , callCommand

40 , callProcess

41 , callProcessAndLogOutput

42− , createProcess

43 , createProcess_

42 , createProcess_

44− , exitCodeToException

45 , overCreateProcess

43 , overCreateProcess

46 , proc

44 , proc

47 , readCreateProcessWithExitCode

45 , readCreateProcessWithExitCode

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

49 , readProcessAndLogStderr

47 , readProcessAndLogStderr

50 , readProcessJSONAndLogStderr

48 , readProcessJSONAndLogStderr

51 , reconstructCommand

49 , reconstructCommand

52− , runProcess_

53 , setCwd

50 , setCwd

54 , setDelegateCtlc

51 , setDelegateCtlc

55 , setEnvOverride

52 , 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, CliLog m)

163+ :: (HasCliConfig e m, CliThrow 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) => Bool -> Bool -> WithSeverity Text -> m ()

180+writeLog :: (MonadIO m, MonadMask 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+29−48

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

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE MultiWayIf #-}

4{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE TupleSections #-}

7{-# LANGUAGE TupleSections #-}

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

16 , callProcessAndLogOutput

17 , callProcessAndLogOutput

17 , createProcess

18 , createProcess

18 , createProcess_

19 , createProcess_

19− , exitCodeToException

20 , overCreateProcess

21 , proc

22 , readCreateProcessWithExitCode

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

24 , readProcessAndLogStderr

25 , readProcessJSONAndLogStderr

26 , reconstructCommand

27− , runProcess_

28 , setCwd

27 , setCwd

29 , setDelegateCtlc

28 , setDelegateCtlc

30 , setEnvOverride

29 , setEnvOverride

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

33 ) where

32 ) where

34

33

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

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

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

37import Control.Monad.Except (throwError)

35import Control.Monad.Except (throwError)

38import Control.Monad.Fail

36import Control.Monad.Fail

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

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

40import Control.Lens (Prism', review)

38import Control.Lens (Prism', review)

41import qualified Data.ByteString as BS

39import qualified Data.ByteString as BS

42import qualified Data.ByteString.Char8 as BSC

40import qualified Data.ByteString.Char8 as BSC

43−import qualified Data.ByteString.UTF8 as BSU

44import Data.Function (fix)

41import Data.Function (fix)

45import Data.Map (Map)

42import Data.Map (Map)

46import qualified Data.Map as Map

43import qualified Data.Map as Map

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

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

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

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

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

59import qualified System.Process as Process

56import qualified System.Process as Process

60−import Text.ShellEscape (bash, bytes)

61import qualified Data.Aeson as Aeson

57import qualified Data.Aeson as Aeson

62

58

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

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

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

101 asProcessFailure = id

97 asProcessFailure = id

102

98

103readProcessAndLogStderr

99readProcessAndLogStderr

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

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

105 => Severity -> ProcessSpec -> m Text

101 => Severity -> ProcessSpec -> m Text

106readProcessAndLogStderr sev process = do

102readProcessAndLogStderr sev process = do

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

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

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

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

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

110

106

111readProcessJSONAndLogStderr

107readProcessJSONAndLogStderr

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

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

113 => Severity -> ProcessSpec -> m a

109 => Severity -> ProcessSpec -> m a

114readProcessJSONAndLogStderr sev process = do

110readProcessJSONAndLogStderr sev process = do

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

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

@@ -122,7 +118,7 @@ readProcessJSONAndLogStderr sev process = do

122 throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) 0

118 throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) 0

123

119

124readCreateProcessWithExitCode

120readCreateProcessWithExitCode

125− :: (MonadIO m, CliLog m)

121+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

126 => ProcessSpec -> m (ExitCode, String, String)

122 => ProcessSpec -> m (ExitCode, String, String)

127readCreateProcessWithExitCode procSpec = do

123readCreateProcessWithExitCode procSpec = do

128 process <- mkCreateProcess procSpec

124 process <- mkCreateProcess procSpec

@@ -132,10 +128,10 @@ readCreateProcessWithExitCode procSpec = do

132-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

128-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

133-- with the corresponding severity.

129-- with the corresponding severity.

134--

130--

135−-- Usually this function is called as `readProcessAndLogOutput (Debug, Error)`. However

131+-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

136-- some processes are known to spit out diagnostic or informative messages in stderr, in

132-- some processes are known to spit out diagnostic or informative messages in stderr, in

137-- which case it is advisable to call it with a non-Error severity for stderr, like

133-- which case it is advisable to call it with a non-Error severity for stderr, like

138−-- `readProcessAndLogOutput (Debug, Debug)`.

134+-- `callProcessAndLogOutput (Debug, Debug)`.

139readProcessAndLogOutput

135readProcessAndLogOutput

140 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

136 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

141 => (Severity, Severity) -> ProcessSpec -> m Text

137 => (Severity, Severity) -> ProcessSpec -> m Text

@@ -148,7 +144,9 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

148 outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

144 outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out

149 putLogRaw sev_out outText

145 putLogRaw sev_out outText

150

146

151− outText <$ (exitCodeToException process =<< waitForProcess p)

147+ waitForProcess p >>= \case

148+ ExitSuccess -> pure outText

149+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

152

150

153-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

151-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

154-- with the corresponding severity.

152-- with the corresponding severity.

@@ -158,7 +156,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

158-- which case it is advisable to call it with a non-Error severity for stderr, like

156-- which case it is advisable to call it with a non-Error severity for stderr, like

159-- `callProcessAndLogOutput (Debug, Debug)`.

157-- `callProcessAndLogOutput (Debug, Debug)`.

160callProcessAndLogOutput

158callProcessAndLogOutput

161− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

159+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

162 => (Severity, Severity) -> ProcessSpec -> m ()

160 => (Severity, Severity) -> ProcessSpec -> m ()

163callProcessAndLogOutput (sev_out, sev_err) process =

161callProcessAndLogOutput (sev_out, sev_err) process =

164 void $ withProcess process $ \out err -> do

162 void $ withProcess process $ \out err -> do

@@ -188,11 +186,12 @@ createProcess_ name procSpec = do

188 liftIO $ Process.createProcess_ name p

186 liftIO $ Process.createProcess_ name p

189

187

190mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

188mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

191−mkCreateProcess (ProcessSpec p override') = case override' of

189+mkCreateProcess (ProcessSpec p override') = do

190+ case override' of

192− Nothing -> pure p

191+ Nothing -> pure p

193− Just override -> do

192+ Just override -> do

194− procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

193+ procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

195− pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

194+ pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

196

195

197-- | Like `System.Process.callProcess` but also logs (debug) the process being run

196-- | Like `System.Process.callProcess` but also logs (debug) the process being run

198callProcess

197callProcess

@@ -211,30 +210,18 @@ callCommand cmd = do

211 liftIO $ Process.callCommand cmd

210 liftIO $ Process.callCommand cmd

212

211

213withProcess

212withProcess

214− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadMask m)

213+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

215 => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

214 => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

216−withProcess process f =

215+withProcess process f = do -- TODO: Use bracket.

217− bracketOnError

216+ -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

218− (createProcess $ overCreateProcess

217+ (_, Just out, Just err, p) <- createProcess $ overCreateProcess

219− (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

218+ (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

220− )

219+

221− (liftIO . Process.cleanupProcess)

220+ f out err -- Pass the handles to the passed function

222− (\case

221+

223− (_, Just out, Just err, p) -> do

222+ waitForProcess p >>= \case

224− f out err

223+ ExitSuccess -> return (out, err)

225− (out, err) <$ (exitCodeToException process =<< waitForProcess p)

224+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

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)

238

225

239-- Create an input stream from the file handle, associating each item with the given severity.

226-- Create an input stream from the file handle, associating each item with the given severity.

240streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

227streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

@@ -253,20 +240,14 @@ streamToLog stream = fix $ \loop -> do

253waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode

240waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode

254waitForProcess = liftIO . Process.waitForProcess

241waitForProcess = liftIO . Process.waitForProcess

255

242

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−

262-- | Pretty print a 'CmdSpec'

243-- | Pretty print a 'CmdSpec'

263reconstructCommand :: Process.CmdSpec -> Text

244reconstructCommand :: Process.CmdSpec -> Text

264reconstructCommand p = case p of

245reconstructCommand p = case p of

265 Process.ShellCommand str -> T.pack str

246 Process.ShellCommand str -> T.pack str

266 Process.RawCommand c as -> processToShellString c as

247 Process.RawCommand c as -> processToShellString c as

267 where

248 where

268− processToShellString cmd args = T.pack $ unwords $

249+ processToShellString cmd args = T.unwords $ map quoteAndEscape (cmd : args)

269− map (BSU.toString . bytes . bash . BSU.fromString) (cmd : args)

250+ quoteAndEscape x = "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

270

251

271reconstructProcSpec :: ProcessSpec -> Text

252reconstructProcSpec :: ProcessSpec -> Text

272reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

253reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

lib/command/obelisk-command.cabal+3−5

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

1name: obelisk-command

2−version: 0.9.0.1

2+version: 0.7.0.1

3cabal-version: >= 1.8

4build-type: Simple

5

@@ -39,15 +39,13 @@ library

39 , optparse-applicative

40 , placeholders

41 , process

42− , shell-escape

43 , temporary

42 , temporary

44 , terminal-size

43 , terminal-size

45 , text

44 , text

46 , time

45 , time

47 , transformers

46 , transformers

48− , unix-compat

47+ , unix

49 , unordered-containers

48 , unordered-containers

50− , utf8-string

51 , which

49 , which

52 , yaml

50 , yaml

53 exposed-modules:

51 exposed-modules:

@@ -66,4 +64,4 @@ library

66executable ob

64executable ob

67 main-is: src-bin/ob.hs

65 main-is: src-bin/ob.hs

68 build-depends: base, obelisk-command

66 build-depends: base, obelisk-command

69− ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -threaded

67+ ghc-options: -Wall -O2 -threaded

lib/command/src/Obelisk/Command.hs+16−23

@@ -22,7 +22,7 @@ import System.Environment

22import System.FilePath

23import qualified System.Info

24import System.IO (hIsTerminalDevice, stdout)

25−import System.Process (rawSystem)

25+import System.Posix.Process (executeFile)

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" <> help "Initialize the project using the given BRANCH of Obelisk's official repository")

77+ , InitSource_Branch <$> strOption (long "branch" <> metavar "BRANCH")

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")

78+ , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH")

79 ]

80

81initForce :: Parser Bool

@@ -99,9 +99,7 @@ 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

102+ | ObInternal_ExportGhciConfig [(FilePath, Interpret)]

103− [(FilePath, Interpret)]

104− Bool -- ^ Use relative paths

105 deriving Show

103 deriving Show

106

104

107obCommand :: ArgsConfig -> Parser ObCommand

105obCommand :: ArgsConfig -> Parser ObCommand

@@ -114,7 +112,7 @@ obCommand cfg = hsubparser

114 , command "thunk" $ info (ObCommand_Thunk <$> thunkOption) $ progDesc "Manipulate thunk directories"

112 , command "thunk" $ info (ObCommand_Thunk <$> thunkOption) $ progDesc "Manipulate thunk directories"

115 , command "repl" $ info (ObCommand_Repl <$> interpretOpts) $ progDesc "Open an interactive interpreter"

113 , command "repl" $ info (ObCommand_Repl <$> interpretOpts) $ progDesc "Open an interactive interpreter"

116 , command "watch" $ info (ObCommand_Watch <$> interpretOpts) $ progDesc "Watch current project for errors and warnings"

114 , command "watch" $ info (ObCommand_Watch <$> interpretOpts) $ progDesc "Watch current project for errors and warnings"

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"

115+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"

118 , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

116 , command "doc" $ info (ObCommand_Doc <$> shellFlags <*> packageNames) $

119 progDesc "List paths to haddock documentation for specified packages"

117 progDesc "List paths to haddock documentation for specified packages"

120 <> footerDoc (Just $

118 <> footerDoc (Just $

@@ -126,11 +124,8 @@ obCommand cfg = hsubparser

126

124

127internalCommand :: Parser ObInternal

125internalCommand :: Parser ObInternal

128internalCommand = hsubparser $ mconcat

126internalCommand = hsubparser $ mconcat

129− [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts <*> useRelativePathsFlag)

130− $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

127+ [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts) $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

131 ]

128 ]

132− where

133− useRelativePathsFlag = switch (long "use-relative-paths" <> help "Use relative paths")

134

129

135packageNames :: Parser [String]

130packageNames :: Parser [String]

136packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

131packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

@@ -230,6 +225,7 @@ data ThunkCommand

230 = ThunkCommand_Update ThunkUpdateConfig

225 = ThunkCommand_Update ThunkUpdateConfig

231 | ThunkCommand_Unpack

226 | ThunkCommand_Unpack

232 | ThunkCommand_Pack ThunkPackConfig

227 | ThunkCommand_Pack ThunkPackConfig

228+ | ThunkCommand_Init

233 deriving Show

229 deriving Show

234

230

235thunkOption :: Parser ThunkOption

231thunkOption :: Parser ThunkOption

@@ -237,6 +233,7 @@ thunkOption = hsubparser $ mconcat

237 [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"

233 [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"

238 , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"

234 , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"

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"

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"

236+ , command "init" $ info (thunkOptionWith $ pure ThunkCommand_Init) $ progDesc "Initialize git checkout by converting it to an unpacked thunk"

240 ]

237 ]

241 where

238 where

242 thunkOptionWith f = ThunkOption

239 thunkOptionWith f = ThunkOption

@@ -285,10 +282,7 @@ shellOpts :: Parser ShellOpts

285shellOpts = ShellOpts

282shellOpts = ShellOpts

286 <$> shellFlags

283 <$> shellFlags

287 <*> interpretOpts

284 <*> 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.

291− <*> ((\xs -> if null xs then Nothing else Just $ unwords xs) <$> many (strArgument (metavar "COMMAND")))

285+ <*> optional (strArgument (metavar "COMMAND"))

292

286

293portOpt :: Int -> Parser Int

287portOpt :: Int -> Parser Int

294portOpt dfault = option auto (long "port" <> short 'p' <> help "Port number for server" <> showDefault <> value dfault <> metavar "INT")

288portOpt dfault = option auto (long "port" <> short 'p' <> help "Port number for server" <> showDefault <> value dfault <> metavar "INT")

@@ -366,8 +360,7 @@ main' argsCfg = do

366 Just impl -> do

360 Just impl -> do

367 -- Invoke the real implementation, using --no-handoff to prevent infinite recursion

361 -- Invoke the real implementation, using --no-handoff to prevent infinite recursion

368 putLog Debug $ "Handing off to " <> T.pack impl

362 putLog Debug $ "Handing off to " <> T.pack impl

369− _ <- liftIO $ rawSystem impl ("--no-handoff" : myArgs)

363+ liftIO $ executeFile impl False ("--no-handoff" : myArgs) Nothing

370− return ()

371 case myArgs of

364 case myArgs of

372 "--no-handoff" : as -> go as -- If we've been told not to hand off, don't hand off

365 "--no-handoff" : as -> go as -- If we've been told not to hand off, don't hand off

373 origPath:inPath:outPath:preprocessorName:packagePaths

366 origPath:inPath:outPath:preprocessorName:packagePaths

@@ -397,21 +390,21 @@ ob = \case

397 ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)

390 ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)

398 ThunkCommand_Unpack -> for_ thunks unpackThunk

391 ThunkCommand_Unpack -> for_ thunks unpackThunk

399 ThunkCommand_Pack config -> for_ thunks (packThunk config)

392 ThunkCommand_Pack config -> for_ thunks (packThunk config)

393+ ThunkCommand_Init -> for_ thunks initThunk

400 where

394 where

401 thunks = _thunkOption_thunks to

395 thunks = _thunkOption_thunks to

402 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

396 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

403 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

397 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

404 ObCommand_Shell (ShellOpts shellAttr interpretPathsList cmd) -> withInterpretPaths interpretPathsList $ \root interpretPaths ->

398 ObCommand_Shell (ShellOpts shellAttr interpretPathsList cmd) -> withInterpretPaths interpretPathsList $ \root interpretPaths ->

405− nixShellForInterpretPaths False shellAttr root interpretPaths cmd -- N.B. We do NOT bash escape here; we want to run the command as-is

399+ nixShellForInterpretPaths False shellAttr root interpretPaths cmd

406− ObCommand_Doc shellAttr pkgs -> withInterpretPaths [] $ \root interpretPaths ->

400+ ObCommand_Doc shellAttr pkgs -> withProjectRoot "." $ \root ->

407− nixShellForInterpretPaths True shellAttr root interpretPaths $ Just $ haddockCommand pkgs

401+ nixShellForInterpretPaths True shellAttr root emptyPathTree $ Just $ haddockCommand pkgs

408 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

402 ObCommand_Hoogle shell' port -> withProjectRoot "." $ \root -> do

409− nixShellWithHoogle root True shell' $ Just $ "hoogle server -p" <> show port <> " --local"

403+ nixShellWithHoogle root True shell' $ Just $ "hoogle server -p " <> show port <> " --local"

410 ObCommand_Internal icmd -> case icmd of

404 ObCommand_Internal icmd -> case icmd of

411 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

405 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

412 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

406 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

413− ObInternal_ExportGhciConfig interpretPathsList useRelativePaths ->

414− liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList (exportGhciConfig useRelativePaths)

407+ ObInternal_ExportGhciConfig interpretPathsList -> liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList exportGhciConfig

415

408

416-- | A helper for the common case that the command you want to run needs the project root and a resolved

409-- | A helper for the common case that the command you want to run needs the project root and a resolved

417-- set of interpret paths.

410-- 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.PosixCompat.Files

28+import System.Posix.Files

29import Text.URI (URI)

30import qualified Text.URI as URI

31import Text.URI.Lens

@@ -85,12 +85,13 @@ 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" $ liftIO $ do

88+ withSpinner "Creating project configuration directories" $ do

89− mapM_ (createDirectoryIfMissing True)

89+ callProcessAndLogOutput (Notice, Error) $

90+ proc "mkdir" [ "-p"

90− [ deployDir </> "config" </> "backend"

91+ , deployDir </> "config" </> "backend"

91− , deployDir </> "config" </> "common"

92+ , deployDir </> "config" </> "common"

92− , deployDir </> "config" </> "frontend"

93+ , deployDir </> "config" </> "frontend"

93− ]

94+ ]

94

95

95 let srcDir = deployDir </> "src"

96 let srcDir = deployDir </> "src"

96 withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ do

97 withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ do

@@ -161,8 +162,8 @@ deployPush deployPath getNixBuilders = do

161 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]

162 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]

162 withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

163 withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do

163 callProcessAndLogOutput (Notice, Warning) $

164 callProcessAndLogOutput (Notice, Warning) $

164− proc rsyncPath

165+ proc "rsync"

165− [ "-e " <> sshPath <> " " <> unwords sshOpts

166+ [ "-e ssh " <> unwords sshOpts

166 , "-qarvz"

167 , "-qarvz"

167 , deployPath </> "config"

168 , deployPath </> "config"

168 , "root@" <> host <> ":/var/lib/backend"

169 , "root@" <> host <> ":/var/lib/backend"

@@ -170,10 +171,9 @@ deployPush deployPath getNixBuilders = do

170 --TODO: Create GC root so we're sure our closure won't go away during this time period

171 --TODO: Create GC root so we're sure our closure won't go away during this time period

171 withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

172 withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do

172 callProcessAndLogOutput (Notice, Warning) $

173 callProcessAndLogOutput (Notice, Warning) $

173− proc sshPath $ sshOpts <>

174+ proc "ssh" $ sshOpts <>

174 [ "root@" <> host

175 [ "root@" <> host

175 , unwords

176 , 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) $

185+ callProcessAndLogOutput (Debug, Error) $ proc "git"

186− gitProc deployPath ["add", "."]

186+ ["-C", deployPath, "add", "."]

187− callProcessAndLogOutput (Debug, Error) $

187+ callProcessAndLogOutput (Debug, Error) $ proc "git"

188− gitProc deployPath ["commit", "-m", "New deployment"]

188+ ["-C", 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 sshPath $

318+ callProcessAndLogOutput (Notice, Warning) $ proc "ssh" $

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' (T.unwords $ "Running" : cmd : desc) (Just $ const $ T.unwords $ "Built" : desc) $ do

210+nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "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' (T.unwords $ "Running" : cmd : desc) (Just $ const

218 NixCmd_Build cfg' -> cfg' ^. nixCommonConfig

219 NixCmd_Instantiate cfg' -> cfg' ^. nixCommonConfig

220 path = commonCfg ^. nixCmdConfig_target . target_path

221− desc = concat $ catMaybes

221+ desc = T.pack $ mconcat $ catMaybes

222− [ (\x -> ["on", T.pack x]) <$> path

222+ [ ("on " <>) <$> path

223− , (\a -> ["[" <> T.pack a <> "]"]) <$> (commonCfg ^. nixCmdConfig_target . target_attr)

223+ , (\a -> " [" <> a <> "]") <$> (commonCfg ^. nixCmdConfig_target . target_attr)

224 ]

lib/command/src/Obelisk/Command/Preprocessor.hs+58−62

@@ -5,96 +5,92 @@ 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_)

9import Data.List (intersperse, isPrefixOf, sortOn)

8import Data.List (intersperse, isPrefixOf, sortOn)

10import Data.Maybe (fromMaybe)

9import Data.Maybe (fromMaybe)

11import qualified Data.Text.Lazy.Builder as TL

10import qualified Data.Text.Lazy.Builder as TL

12import qualified Data.Text.Lazy.Encoding as TL

11import qualified Data.Text.Lazy.Encoding as TL

13import Distribution.Compiler (CompilerFlavor (..))

12import Distribution.Compiler (CompilerFlavor (..))

14import Language.Haskell.Extension (Extension (..), Language(..))

13import Language.Haskell.Extension (Extension (..), Language(..))

15−import System.Directory (canonicalizePath)

16−import System.IO (IOMode (..), hPutStrLn, stderr, withFile)

14+import System.IO (IOMode (..), hClose, hPutStrLn, openFile, stderr)

17−import System.FilePath (hasTrailingPathSeparator, joinPath, splitPath)

15+import System.FilePath (hasTrailingPathSeparator, joinPath, normalise, splitPath)

18

16

19import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage')

17import Obelisk.Command.Run (CabalPackageInfo (..), parseCabalPackage')

20

18

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.

29applyPackages :: FilePath -> FilePath -> FilePath -> [FilePath] -> IO ()

19applyPackages :: FilePath -> FilePath -> FilePath -> [FilePath] -> IO ()

30−applyPackages origPath inPath outPath packagePaths' = do

20+applyPackages origPath inPath outPath packagePaths = do

31− origPathCanonical <- canonicalizePath origPath

21+ -- This code is intended to be executed via ghci's -pgmF preprocessor option

32− packagePaths <- traverse canonicalizePath packagePaths'

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.

33

28

34− let

29+ outFile <- openFile outPath WriteMode

35− takeDirs = takeWhile hasTrailingPathSeparator

30+ let hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText

36− packageDirs = sortOn (negate . length . takeDirs) $ map splitPath packagePaths

37− origDir = splitPath origPathCanonical

38− matches = [ joinPath d | d <- packageDirs, takeDirs d `isPrefixOf` origDir ]

39

31

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+

40− -- The first element of matches is going to be the deepest path to a package spec that contains

43+ -- So the first element of matches is going to be the deepest path to a package spec that contains

41 -- our file as a subdirectory.

44 -- our file as a subdirectory.

45+

42− packageInfo' <- case matches of

46+ case matches of

43− [] -> do

47+ [] -> hPutTextBuilder outFile (lineNumberPragma origPath) -- TODO: probably should produce a warning

44− hPutStrLn stderr $ "Error: Unable to find cabal information for " <> origPath <> "; Skipping preprocessor."

48+ (packagePath:_) -> do

45− pure Nothing

46− packagePath:_ -> parseCabalPackage' packagePath >>= \case

49+ parseCabalPackage' packagePath >>= \case

47− Left err -> do

50+ Left err ->

48− hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error: " <> show err

51+ hPutStrLn stderr $ "Error: Unable to parse cabal package " <> packagePath <> "; Skipping preprocessor on " <> origPath <> ". Error was " <> show err

49− pure Nothing

50− Right (Just (_, packageInfo)) -> pure $ Just packageInfo

52+ Right (_warnings, 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

57− for_ packageInfo' $ \packageInfo -> hPutTextBuilder hOut (generateHeader origPath packageInfo)

53+ hPutTextBuilder outFile (generateHeader origPath packageInfo)

54+

58− BL.readFile origPath >>= BL.hPut hOut

55+ BL.readFile inPath >>= BL.hPut outFile

59− where

56+ hClose outFile

60− hPutTextBuilder h = BU.hPutBuilder h . TL.encodeUtf8Builder . TL.toLazyText

57+

58+

59+ -- I'm pretty sure there's a certain amount of oversimplification in CabalPackageInfo, so I doubt this is fully robust.

61

60

62generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

61generateHeader :: FilePath -> CabalPackageInfo -> TL.Builder

63generateHeader origPath packageInfo =

62generateHeader origPath packageInfo =

64 hsExtensions <> ghcOptions <> lineNumberPragma origPath

63 hsExtensions <> ghcOptions <> lineNumberPragma origPath

65 where

64 where

66 hsExtensions =

65 hsExtensions =

67− if null extList

66+ if not (null extList)

68− then mempty

67+ then TL.fromText "{-# LANGUAGE "

69− else pragma $ TL.fromText "LANGUAGE " <> mconcat (intersperse (TL.fromText ", ") extList)

68+ <> mconcat (intersperse (TL.fromText ", ") extList)

69+ <> TL.fromText " #-}\n"

70+ else mempty

70 extList = addDefaultLanguage $ concatMap showExt $ _cabalPackageInfo_defaultExtensions packageInfo

71 extList = addDefaultLanguage $ concatMap showExt $ _cabalPackageInfo_defaultExtensions packageInfo

71 addDefaultLanguage =

72 addDefaultLanguage =

72 case _cabalPackageInfo_defaultLanguage packageInfo of

73 case _cabalPackageInfo_defaultLanguage packageInfo of

73 Nothing -> id

74 Nothing -> id

74 Just x -> case x of

75 Just x -> case x of

75− UnknownLanguage ext -> (TL.fromString ext :)

76+ UnknownLanguage ext -> ( TL.fromString ext :)

76− ext -> (TL.fromString (show ext) :)

77+ ext -> ( TL.fromString (show ext) :)

77 showExt = \case

78 showExt = \case

78 EnableExtension ext -> [TL.fromString (show ext)]

79 EnableExtension ext -> [TL.fromString (show ext)]

79− DisableExtension ext -> ["No" <> TL.fromString (show ext)]

80+ DisableExtension _ -> []

80 UnknownExtension ext -> [TL.fromString ext]

81 UnknownExtension ext -> [TL.fromString ext]

81

82

82 ghcOptions =

83 ghcOptions =

83− if null optList

84+ if not (null optList)

84− then mempty

85+ then TL.fromText "{-# OPTIONS_GHC "

85− else pragma $

86− TL.fromText "OPTIONS_GHC " <> mconcat (intersperse (TL.fromText " ") (map TL.fromString optList))

86+ <> mconcat (intersperse (TL.fromText " ") optList)

87− ghcOptList

87+ <> TL.fromText " #-}\n"

88+ else mempty

89+ optList = map TL.fromString

88− = filter (not . isPrefixOf "-O")

90+ $ filter (\x -> not (isPrefixOf "-O" x))

89− $ fromMaybe []

91+ $ fromMaybe []

90− $ lookup GHC (_cabalPackageInfo_compilerOptions packageInfo)

92+ $ lookup GHC (_cabalPackageInfo_compilerOptions packageInfo)

91− optList = _cabalPackageInfo_cppOptions packageInfo <> ghcOptList

92

93

93lineNumberPragma :: FilePath -> TL.Builder

94lineNumberPragma :: FilePath -> TL.Builder

95+lineNumberPragma origPath =

94−lineNumberPragma origPath = pragma $ TL.fromText "LINE 1 " <> quoted '"' (TL.fromString origPath)

96+ TL.fromText "{-# LINE 1 \"" <> TL.fromString origPath <> TL.fromText "\" #-}\n"

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+15−26

@@ -15,7 +15,6 @@ module Obelisk.Command.Project

15 , toImplDir

16 , toObeliskDir

17 , withProjectRoot

18− , bashEscape

19 ) where

18 ) where

20

19

21import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

20import Control.Concurrent.MVar (MVar, newMVar, withMVarMasked)

@@ -24,7 +23,6 @@ import Control.Monad

24import Control.Monad.IO.Class (liftIO)

23import Control.Monad.IO.Class (liftIO)

25import Control.Monad.State

24import Control.Monad.State

26import qualified Data.Aeson as Json

25import qualified Data.Aeson as Json

27−import qualified Data.ByteString.UTF8 as BSU

28import Data.Bits

26import Data.Bits

29import qualified Data.ByteString.Lazy as BSL

27import qualified Data.ByteString.Lazy as BSL

30import Data.Default (def)

28import Data.Default (def)

@@ -32,17 +30,15 @@ import Data.Function ((&), on)

32import Data.Map (Map)

30import Data.Map (Map)

33import Data.Text (Text)

31import Data.Text (Text)

34import qualified Data.Text as T

32import qualified Data.Text as T

35−import Data.Text.Encoding (decodeUtf8, encodeUtf8)

33+import Data.Text.Encoding (decodeUtf8)

36import Data.Traversable (for)

34import Data.Traversable (for)

37import System.Directory

35import System.Directory

38import System.Environment (lookupEnv)

36import System.Environment (lookupEnv)

39import System.FilePath

37import System.FilePath

40import System.IO.Temp

38import System.IO.Temp

41import System.IO.Unsafe (unsafePerformIO)

39import System.IO.Unsafe (unsafePerformIO)

42−import System.PosixCompat.Files

40+import System.Posix (FileStatus, FileMode, CMode (..), UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)

43−import System.PosixCompat.Types

41+import System.Posix.Files

44−import System.PosixCompat.User

45−import Text.ShellEscape (bash, bytes)

46

42

47import GitHub.Data.GitData (Branch)

43import GitHub.Data.GitData (Branch)

48import GitHub.Data.Name (Name)

44import GitHub.Data.Name (Name)

@@ -51,7 +47,7 @@ import Obelisk.App (MonadObelisk)

51import Obelisk.CliApp

47import Obelisk.CliApp

52import Obelisk.Command.Nix

48import Obelisk.Command.Nix

53import Obelisk.Command.Thunk

49import Obelisk.Command.Thunk

54−import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath, cp, nixShellPath)

50+import Obelisk.Command.Utils (nixBuildExePath, nixExePath, toNixPath)

55

51

56--TODO: Make this module resilient to random exceptions

52--TODO: Make this module resilient to random exceptions

57

53

@@ -116,7 +112,7 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

116 skel <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

112 skel <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

117

113

118 callProcessAndLogOutput (Notice, Error) $

114 callProcessAndLogOutput (Notice, Error) $

119− proc cp

115+ proc "cp"

120 [ "-r"

116 [ "-r"

121 , "--preserve=links"

117 , "--preserve=links"

122 , obDir

118 , obDir

@@ -126,7 +122,7 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

126

122

127 withSpinner "Copying project skeleton" $ do

123 withSpinner "Copying project skeleton" $ do

128 callProcessAndLogOutput (Notice, Error) $

124 callProcessAndLogOutput (Notice, Error) $

129− proc cp

125+ proc "cp"

130 [ "-r"

126 [ "-r"

131 , "--no-preserve=mode"

127 , "--no-preserve=mode"

132 , "-T"

128 , "-T"

@@ -137,12 +133,6 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do

137 let configDir = "config"

133 let configDir = "config"

138 createDirectoryIfMissing False configDir

134 createDirectoryIfMissing False configDir

139 mapM_ (createDirectoryIfMissing False . (configDir </>)) ["backend", "common", "frontend"]

135 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− ]

146

136

147callHandoffOb

137callHandoffOb

148 :: MonadObelisk m

138 :: MonadObelisk m

@@ -288,17 +278,14 @@ nixShellRunConfig root isPure command = do

288 pure $ def

278 pure $ def

289 & nixShellConfig_pure .~ isPure

279 & nixShellConfig_pure .~ isPure

290 & nixShellConfig_common . nixCmdConfig_target .~ (def & target_path .~ Nothing)

280 & nixShellConfig_common . nixCmdConfig_target .~ (def & target_path .~ Nothing)

291− & nixShellConfig_run .~ (command <&> \cs -> unwords $ concat

281+ & nixShellConfig_run .~ (command <&> \c -> mconcat

292− [ ["export", BSU.toString . bytes . bash $ "NIX_PATH=nixpkgs=" <> encodeUtf8 nixpkgsPath, ";"]

282+ [ "export NIX_PATH=nixpkgs=", T.unpack nixpkgsPath, "; "

293− , maybe [] (\v -> ["export", BSU.toString . bytes . bash $ "NIX_REMOTE=" <> encodeUtf8 (T.pack v), ";"]) nixRemote

283+ , maybe "" (\v -> "export NIX_REMOTE=" <> v <> "; ") nixRemote

294− , [cs]

284+ , c

295 ])

285 ])

296

286

297−bashEscape :: String -> String

298−bashEscape = BSU.toString . bytes . bash . BSU.fromString

299−

300nixShellRunProc :: NixShellConfig -> ProcessSpec

287nixShellRunProc :: NixShellConfig -> ProcessSpec

301−nixShellRunProc cfg = setDelegateCtlc True $ proc nixShellPath $ runNixShellConfig cfg

288+nixShellRunProc cfg = setDelegateCtlc True $ proc "nix-shell" $ runNixShellConfig cfg

302

289

303nixShellWithoutPkgs

290nixShellWithoutPkgs

304 :: MonadObelisk m

291 :: MonadObelisk m

@@ -313,7 +300,7 @@ nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr comma

313 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

300 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute

314 defShellConfig <- nixShellRunConfig root isPure command

301 defShellConfig <- nixShellRunConfig root isPure command

315 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

302 let setCwd_ = if chdirToRoot then setCwd (Just root) else id

316− runProcess_ $ setCwd_ $ nixShellRunProc $ defShellConfig

303+ (_, _, _, ph) <- createProcess_ "nixShellWithoutPkgs" $ setCwd_ $ nixShellRunProc $ defShellConfig

317 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

304 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

318 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

305 "{root, pkgs, shell}: ((import root {}).passthru.__unstable__.self.extend (_: _: {\

319 \shellPackages = builtins.fromJSON pkgs;\

306 \shellPackages = builtins.fromJSON pkgs;\

@@ -323,16 +310,18 @@ nixShellWithoutPkgs root isPure chdirToRoot packageNamesAndPaths shellAttr comma

323 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

310 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)

324 , strArg "shell" shellAttr

311 , strArg "shell" shellAttr

325 ]

312 ]

313+ void $ waitForProcess ph

326

314

327nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

315nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

328nixShellWithHoogle root isPure shell' command = do

316nixShellWithHoogle root isPure shell' command = do

329 defShellConfig <- nixShellRunConfig root isPure command

317 defShellConfig <- nixShellRunConfig root isPure command

330− runProcess_ $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

318+ (_, _, _, ph) <- createProcess_ "nixShellWithHoogle" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig

331 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

319 & nixShellConfig_common . nixCmdConfig_target . target_expr ?~

332 "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\

320 "{shell}: ((import ./. {}).passthru.__unstable__.self.extend (_: super: {\

333 \userSettings = super.userSettings // { withHoogle = true; };\

321 \userSettings = super.userSettings // { withHoogle = true; };\

334 \})).project.shells.${shell}"

322 \})).project.shells.${shell}"

335 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

323 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]

324+ void $ waitForProcess ph

336

325

337findProjectAssets :: MonadObelisk m => FilePath -> m Text

326findProjectAssets :: MonadObelisk m => FilePath -> m Text

338findProjectAssets root = do

327findProjectAssets root = do

lib/command/src/Obelisk/Command/Run.hs+69−83

@@ -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)

17+import Control.Monad (filterM, unless, void)

18import Control.Monad.Except (runExceptT, throwError)

19import Control.Monad.IO.Class (liftIO)

20import Control.Monad.Reader (MonadIO)

@@ -25,14 +25,12 @@ import Data.Default (def)

25import Data.Either (partitionEithers)

26import Data.Foldable (fold, for_, toList)

27import Data.Functor.Identity (runIdentity)

28−import Data.List (intercalate)

29import Data.List.NonEmpty (NonEmpty)

28import Data.List.NonEmpty (NonEmpty)

30import qualified Data.List.NonEmpty as NE

29import qualified Data.List.NonEmpty as NE

31import Data.Map (Map)

30import Data.Map (Map)

32import qualified Data.Map as Map

31import qualified Data.Map as Map

33import qualified Data.Map.Monoidal as MMap

32import qualified Data.Map.Monoidal as MMap

34−import Data.Maybe (catMaybes, fromMaybe, mapMaybe)

33+import Data.Maybe

35−import Data.Ord (comparing)

36import Data.Set (Set)

34import Data.Set (Set)

37import qualified Data.Set as Set

35import qualified Data.Set as Set

38import Data.String.Here.Interpolated (i)

36import Data.String.Here.Interpolated (i)

@@ -46,17 +44,17 @@ import Distribution.Compiler (CompilerFlavor(..))

46import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

44import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

47import Distribution.Parsec.ParseResult (runParseResult)

45import Distribution.Parsec.ParseResult (runParseResult)

48import qualified Distribution.System as Dist

46import qualified Distribution.System as Dist

49−import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options)

47+import Distribution.Types.BuildInfo

50−import Distribution.Types.CondTree (simplifyCondTree)

48+import Distribution.Types.CondTree

51−import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

49+import Distribution.Types.GenericPackageDescription

52−import Distribution.Types.Library (libBuildInfo)

50+import Distribution.Types.Library

53−import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

51+import Distribution.Utils.Generic

54import qualified Distribution.Parsec.Common as Dist

52import qualified Distribution.Parsec.Common as Dist

55import qualified Hpack.Config as Hpack

53import qualified Hpack.Config as Hpack

56import qualified Hpack.Render as Hpack

54import qualified Hpack.Render as Hpack

57import qualified Hpack.Yaml as Hpack

55import qualified Hpack.Yaml as Hpack

58−import Language.Haskell.Extension (Extension, Language)

56+import Language.Haskell.Extension

59−import qualified Network.Socket as Socket

57+import Network.Socket hiding (Debug)

60import System.Directory

58import System.Directory

61import System.Environment (getExecutablePath)

59import System.Environment (getExecutablePath)

62import System.FilePath

60import System.FilePath

@@ -66,18 +64,19 @@ import System.IO.Temp (withSystemTempDirectory)

66import Obelisk.App (MonadObelisk)

64import Obelisk.App (MonadObelisk)

67import Obelisk.CliApp (

65import Obelisk.CliApp (

68 Severity (..),

66 Severity (..),

67+ createProcess_,

69 failWith,

68 failWith,

70 proc,

69 proc,

71 putLog,

70 putLog,

72 readCreateProcessWithExitCode,

71 readCreateProcessWithExitCode,

73 readProcessAndLogStderr,

72 readProcessAndLogStderr,

74− runProcess_,

75 setCwd,

73 setCwd,

76 setDelegateCtlc,

74 setDelegateCtlc,

75+ waitForProcess,

77 withSpinner,

76 withSpinner,

78 )

77 )

79import Obelisk.Command.Nix

78import Obelisk.Command.Nix

80−import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets, bashEscape)

79+import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets)

81import Obelisk.Command.Thunk (attrCacheFileName)

80import Obelisk.Command.Thunk (attrCacheFileName)

82import Obelisk.Command.Utils (findExePath, ghcidExePath)

81import Obelisk.Command.Utils (findExePath, ghcidExePath)

83

82

@@ -94,11 +93,9 @@ data CabalPackageInfo = CabalPackageInfo

94 -- ^ List of globally set languages of the library component

93 -- ^ List of globally set languages of the library component

95 , _cabalPackageInfo_compilerOptions :: [(CompilerFlavor, [String])]

94 , _cabalPackageInfo_compilerOptions :: [(CompilerFlavor, [String])]

96 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)

95 -- ^ 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)

99 }

96 }

100

97

101−-- | 'Bool' with a better name for its purpose.

98+-- | 'Bool' with a better name for it's purpose.

102data Interpret = Interpret_Interpret | Interpret_NoInterpret deriving (Eq, Ord, Show)

99data Interpret = Interpret_Interpret | Interpret_NoInterpret deriving (Eq, Ord, Show)

103

100

104textInterpret :: Interpret -> Text

101textInterpret :: Interpret -> Text

@@ -112,6 +109,9 @@ data PathTree a = PathTree_Node

112 (Map FilePath (PathTree a)) -- Branches to deeper leaves

109 (Map FilePath (PathTree a)) -- Branches to deeper leaves

113 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

110 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

114

111

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− runProcess_ $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $

154+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $

155 [ show freePort

156 , T.unpack assets

157 , profileBaseName

@@ -159,16 +159,17 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

159 , "-po" <> profileBaseName

160 ] <> rtsFlags

161 <> [ "-RTS" ]

162+ void $ waitForProcess ph

162

163

163run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

164run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

164run root interpretPaths = do

165run root interpretPaths = do

165 pkgs <- getParsedLocalPkgs root interpretPaths

166 pkgs <- getParsedLocalPkgs root interpretPaths

167+ withGhciScript pkgs $ \dotGhciPath -> do

166− assets <- findProjectAssets root

168+ assets <- findProjectAssets root

167− putLog Debug $ "Assets impurely loaded from: " <> assets

169+ putLog Debug $ "Assets impurely loaded from: " <> assets

168− ghciArgs <- getGhciSessionSettings pkgs root True

170+ ghciArgs <- getGhciSessionSettings pkgs root

169− freePort <- getFreePort

171+ freePort <- getFreePort

170− withGhciScriptArgs pkgs $ \dotGhciArgs -> do

171− runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords

172+ runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs $ Just $ unwords

172 [ "Obelisk.Run.run"

173 [ "Obelisk.Run.run"

173 , show freePort

174 , show freePort

174 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

175 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"

@@ -179,21 +180,21 @@ run root interpretPaths = do

179runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

180runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

180runRepl root interpretPaths = do

181runRepl root interpretPaths = do

181 pkgs <- getParsedLocalPkgs root interpretPaths

182 pkgs <- getParsedLocalPkgs root interpretPaths

182− ghciArgs <- getGhciSessionSettings pkgs "." True

183+ ghciArgs <- getGhciSessionSettings pkgs "."

183− withGhciScriptArgs pkgs $ \dotGhciArgs ->

184+ withGhciScript pkgs $ \dotGhciPath ->

184− runGhciRepl root pkgs (ghciArgs <> dotGhciArgs)

185+ runGhciRepl root pkgs (ghciArgs <> mkGhciScriptArg dotGhciPath)

185

186

186runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

187runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

187runWatch root interpretPaths = do

188runWatch root interpretPaths = do

188 pkgs <- getParsedLocalPkgs root interpretPaths

189 pkgs <- getParsedLocalPkgs root interpretPaths

189− ghciArgs <- getGhciSessionSettings pkgs root True

190+ ghciArgs <- getGhciSessionSettings pkgs root

190− withGhciScriptArgs pkgs $ \dotGhciArgs ->

191+ withGhciScript pkgs $ \dotGhciPath ->

191− runGhcid root True (ghciArgs <> dotGhciArgs) pkgs Nothing

192+ runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs Nothing

192

193

193−exportGhciConfig :: MonadObelisk m => Bool -> FilePath -> PathTree Interpret -> m [String]

194+exportGhciConfig :: MonadObelisk m => FilePath -> PathTree Interpret -> m [String]

194−exportGhciConfig useRelativePaths root interpretPaths = do

195+exportGhciConfig root interpretPaths = do

195 pkgs <- getParsedLocalPkgs root interpretPaths

196 pkgs <- getParsedLocalPkgs root interpretPaths

196− getGhciSessionSettings pkgs "." useRelativePaths

197+ getGhciSessionSettings pkgs "."

197

198

198nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()

199nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()

199nixShellForInterpretPaths isPure shell root interpretPaths cmd = do

200nixShellForInterpretPaths isPure shell root interpretPaths cmd = do

@@ -304,16 +305,15 @@ parseCabalPackage

304 -> m (Maybe CabalPackageInfo)

305 -> m (Maybe CabalPackageInfo)

305parseCabalPackage dir = parseCabalPackage' dir >>= \case

306parseCabalPackage dir = parseCabalPackage' dir >>= \case

306 Left err -> Nothing <$ putLog Error err

307 Left err -> Nothing <$ putLog Error err

307− Right (Just (warnings, pkgInfo)) -> do

308+ Right (warnings, pkgInfo) -> do

308 for_ warnings $ putLog Warning . T.pack . show

309 for_ warnings $ putLog Warning . T.pack . show

309 pure $ Just pkgInfo

310 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 (Maybe ([Dist.PWarning], CabalPackageInfo)))

316+ -> m (Either T.Text ([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 $ Just $ (warnings,) $ CabalPackageInfo

344+ pure $ (warnings,) $ CabalPackageInfo

345 { _cabalPackageInfo_packageName = T.pack packageName

346 , _cabalPackageInfo_packageFile = packageFile

347 , _cabalPackageInfo_packageRoot = takeDirectory packageFile

@@ -353,19 +353,18 @@ parseCabalPackage' pkg = runExceptT $ do

353 , _cabalPackageInfo_defaultLanguage =

354 defaultLanguage $ libBuildInfo lib

355 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

356− , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib

357 }

356 }

358− Right Nothing -> pure Nothing

357+ Right Nothing -> throwError "Haskell package has no library component"

359 Left (_, errors) ->

358 Left (_, errors) ->

360 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)

359 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)

361

360

362parsePackagesOrFail :: (MonadObelisk m, Foldable f) => f FilePath -> m (NE.NonEmpty CabalPackageInfo)

361parsePackagesOrFail :: (MonadObelisk m, Foldable f) => f FilePath -> m (NE.NonEmpty CabalPackageInfo)

363parsePackagesOrFail dirs' = do

362parsePackagesOrFail dirs' = do

364− packageInfos' <- fmap catMaybes $ for dirs $ \dir -> do

363+ (pkgDirErrs, packageInfos') <- fmap partitionEithers $ for dirs $ \dir -> do

365 flip fmap (parseCabalPackage dir) $ \case

364 flip fmap (parseCabalPackage dir) $ \case

366 Just packageInfo

365 Just packageInfo

367− | _cabalPackageInfo_buildable packageInfo -> Just packageInfo

366+ | _cabalPackageInfo_buildable packageInfo -> Right packageInfo

368− _ -> Nothing

367+ _ -> Left dir

369

368

370 -- Sort duplicate packages such that we prefer shorter paths, but fall back to alphabetical ordering.

369 -- Sort duplicate packages such that we prefer shorter paths, but fall back to alphabetical ordering.

371 let packagesByName = Map.map (NE.sortBy $ comparing $ \p -> let n = _cabalPackageInfo_packageFile p in (length n, n))

370 let packagesByName = Map.map (NE.sortBy $ comparing $ \p -> let n = _cabalPackageInfo_packageFile p in (length n, n))

@@ -387,6 +386,9 @@ parsePackagesOrFail dirs' = do

387 "No valid, buildable packages found" <> (if null dirs then "" else " in " <> intercalate ", " dirs)

386 "No valid, buildable packages found" <> (if null dirs then "" else " in " <> intercalate ", " dirs)

388 Just xs -> pure xs

387 Just xs -> pure xs

389

388

389+ unless (null pkgDirErrs) $

390+ putLog Warning $ T.pack $ "Failed to find buildable packages in " <> intercalate ", " pkgDirErrs

391+

390 pure packageInfos

392 pure packageInfos

391 where

393 where

392 dirs = toList dirs'

394 dirs = toList dirs'

@@ -394,29 +396,13 @@ parsePackagesOrFail dirs' = do

394packageInfoToNamePathMap :: Foldable f => f CabalPackageInfo -> Map Text FilePath

396packageInfoToNamePathMap :: Foldable f => f CabalPackageInfo -> Map Text FilePath

395packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot) . toList

397packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot) . toList

396

398

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−

412-- | Create ghci configuration to load the given packages

399-- | Create ghci configuration to load the given packages

413withGhciScript

400withGhciScript

414 :: (MonadObelisk m, Foldable f)

401 :: (MonadObelisk m, Foldable f)

415− => [String] -- ^ Commands to prefix to file

416− -> f CabalPackageInfo -- ^ List of packages to load into ghci

402+ => f CabalPackageInfo -- ^ List of packages to load into ghci

417 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

403 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

418 -> m ()

404 -> m ()

419−withGhciScript preCommands (toList -> packageInfos) f =

405+withGhciScript (toList -> packageInfos) f =

420 withSystemTempDirectory "ob-ghci" $ \fp -> do

406 withSystemTempDirectory "ob-ghci" $ \fp -> do

421 let dotGhciPath = fp </> ".ghci"

407 let dotGhciPath = fp </> ".ghci"

422 liftIO $ writeFile dotGhciPath dotGhci

408 liftIO $ writeFile dotGhciPath dotGhci

@@ -428,8 +414,7 @@ withGhciScript preCommands (toList -> packageInfos) f =

428 , [ "Backend" | "backend" `Set.member` packageNames ]

414 , [ "Backend" | "backend" `Set.member` packageNames ]

429 , [ "Frontend" | "frontend" `Set.member` packageNames ]

415 , [ "Frontend" | "frontend" `Set.member` packageNames ]

430 ]

416 ]

431− dotGhci = unlines $

417+ dotGhci = unlines

432− preCommands <>

433 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

418 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

434 , "import qualified Obelisk.Run"

419 , "import qualified Obelisk.Run"

435 , "import qualified Frontend"

420 , "import qualified Frontend"

@@ -442,9 +427,8 @@ getGhciSessionSettings

442 :: (MonadObelisk m, Foldable f)

427 :: (MonadObelisk m, Foldable f)

443 => f CabalPackageInfo -- ^ List of packages to load into ghci

428 => f CabalPackageInfo -- ^ List of packages to load into ghci

444 -> FilePath -- ^ All paths will be relative to this path

429 -> FilePath -- ^ All paths will be relative to this path

445− -> Bool -- ^ Use relative paths

446 -> m [String]

430 -> m [String]

447−getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

431+getGhciSessionSettings (toList -> packageInfos) pathBase = do

448 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that

432 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that

449 -- paths-with-spaces ruin our day, we first canonicalize everything, and then relativize

433 -- paths-with-spaces ruin our day, we first canonicalize everything, and then relativize

450 -- all paths to 'pathBase'.

434 -- all paths to 'pathBase'.

@@ -454,15 +438,13 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

454 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

438 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

455 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

439 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

456 canonicalPkgFile <- canonicalizePath $ _cabalPackageInfo_packageFile pkg

440 canonicalPkgFile <- canonicalizePath $ _cabalPackageInfo_packageFile pkg

457− pure (canonicalPkgFile `relativeTo'` canonicalPathBase, (`relativeTo'` canonicalPathBase) <$> canonicalSrcDirs)

441+ pure (canonicalPkgFile `relativeTo` canonicalPathBase, (`relativeTo` canonicalPathBase) <$> canonicalSrcDirs)

458

442

459 pure

443 pure

460 $ baseGhciOptions

444 $ baseGhciOptions

461 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

445 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

462 <> concatMap (\p -> ["-optF", p]) pkgFiles

446 <> concatMap (\p -> ["-optF", p]) pkgFiles

463 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

447 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

464− where

465− relativeTo' = if useRelativePaths then relativeTo else const

466

448

467baseGhciOptions :: [String]

449baseGhciOptions :: [String]

468baseGhciOptions =

450baseGhciOptions =

@@ -482,7 +464,7 @@ runGhciRepl root (toList -> packages) ghciArgs =

482 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

464 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

483 -- ghc that is provided by the shell in the user's project.

465 -- ghc that is provided by the shell in the user's project.

484 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

466 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

485− Just $ unwords $ fmap bashEscape $ "ghci" : ghciArgs

467+ Just $ unwords $ "ghci" : ghciArgs -- TODO: Shell escape

486

468

487-- | Run ghcid

469-- | Run ghcid

488runGhcid

470runGhcid

@@ -495,28 +477,32 @@ runGhcid

495 -> m ()

477 -> m ()

496runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

478runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

497 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

479 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

498− Just $ unwords $ fmap bashEscape $ ghcidExePath : opts

480+ Just $ unwords $ ghcidExePath : opts -- TODO: Shell escape

499 where

481 where

500− opts = concat

482+ opts =

501− [ ["-W"]

483+ [ "-W"

502− , ["--outputfile=ghcid-output.txt"]

484+ , "--outputfile=ghcid-output.txt"

503− , map (\x -> "--reload=" <> x) reloadFiles

485+ ] <> map (\x -> "--reload='" <> x <> "'") reloadFiles

504− , map (\x -> "--restart=" <> x) restartFiles

486+ <> map (\x -> "--restart='" <> x <> "'") restartFiles

505− , maybe [] (\cmd -> ["--test=" <> cmd]) mcmd

487+ <> testCmd

506− , ["--command=" <> unwords ("ghci" : ghciArgs)]

488+ <> ["--command='" <> unwords ("ghci" : ghciArgs) <> "'"] -- TODO: Shell escape

507− ]

489+ testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'") -- TODO: Shell escape

490+

508 adjustRoot x = if chdirToRoot then makeRelative root x else x

491 adjustRoot x = if chdirToRoot then makeRelative root x else x

509 reloadFiles = map adjustRoot [root </> "config"]

492 reloadFiles = map adjustRoot [root </> "config"]

510 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

493 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

511

494

495+mkGhciScriptArg :: FilePath -> [String]

496+mkGhciScriptArg dotGhci = ["-ghci-script", dotGhci]

497+

512−getFreePort :: MonadIO m => m Socket.PortNumber

498+getFreePort :: MonadIO m => m PortNumber

513−getFreePort = liftIO $ Socket.withSocketsDo $ do

499+getFreePort = liftIO $ withSocketsDo $ do

514− addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")

500+ addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")

515− bracket (open addr) Socket.close Socket.socketPort

501+ bracket (open addr) close socketPort

516 where

502 where

517 open addr = do

503 open addr = do

518− sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)

504+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

519− Socket.bind sock (Socket.addrAddress addr)

505+ bind sock (addrAddress addr)

520 return sock

506 return sock

521

507

522

508

@@ -551,4 +537,4 @@ relativeTo dir base

551 $ zipDefaultWith Nothing Nothing (,)

537 $ zipDefaultWith Nothing Nothing (,)

552 (map Just $ splitDirectories base)

538 (map Just $ splitDirectories base)

553 (map Just $ splitDirectories dir)

539 (map Just $ splitDirectories dir)

554− where collapse = foldr (</>) ""

540+ where collapse = foldr (</>) ""

lib/command/src/Obelisk/Command/Thunk.hs+32−22

@@ -14,14 +14,13 @@ import Control.Applicative

14import Control.Exception (displayException, try)

15import Control.Lens (ifor, ifor_, (.~))

16import Control.Monad

17−import Control.Monad.Extra (findM)

17+import Control.Monad.Extra (findM, unlessM, whenM)

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)

25import qualified Data.ByteString.Lazy as LBS

24import qualified Data.ByteString.Lazy as LBS

26import Data.Containers.ListUtils (nubOrd)

25import Data.Containers.ListUtils (nubOrd)

27import Data.Default

26import Data.Default

@@ -56,7 +55,7 @@ import System.Exit

56import System.FilePath

55import System.FilePath

57import System.IO.Error

56import System.IO.Error

58import System.IO.Temp

57import System.IO.Temp

59−import System.PosixCompat.Files (getSymbolicLinkStatus, modificationTime)

58+import System.Posix (getSymbolicLinkStatus, modificationTime)

60import qualified Text.URI as URI

59import qualified Text.URI as URI

61

60

62import Obelisk.App (MonadObelisk)

61import Obelisk.App (MonadObelisk)

@@ -178,14 +177,14 @@ getNixSha256ForUriUnpacked

178getNixSha256ForUriUnpacked uri =

177getNixSha256ForUriUnpacked uri =

179 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

178 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

180 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

179 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

181− proc nixPrefetchUrlPath ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

180+ proc "nix-prefetch-url" ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

182 pure hash

181 pure hash

183

182

184nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

183nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

185nixPrefetchGit uri rev fetchSubmodules =

184nixPrefetchGit uri rev fetchSubmodules =

186 withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

185 withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

187 out <- readProcessAndLogStderr Debug $

186 out <- readProcessAndLogStderr Debug $

188− proc nixPrefetchGitPath $ filter (/="")

187+ proc "nix-prefetch-git" $ filter (/="")

189 [ "--url", T.unpack $ gitUriToText uri

188 [ "--url", T.unpack $ gitUriToText uri

190 , "--rev", T.unpack rev

189 , "--rev", T.unpack rev

191 , if fetchSubmodules then "--fetch-submodules" else ""

190 , if fetchSubmodules then "--fetch-submodules" else ""

@@ -209,7 +208,7 @@ data ReadThunkError

209 deriving (Show)

208 deriving (Show)

210

209

211unpackedDirName :: FilePath

210unpackedDirName :: FilePath

212−unpackedDirName = "."

211+unpackedDirName = "local"

213

212

214attrCacheFileName :: FilePath

213attrCacheFileName :: FilePath

215attrCacheFileName = ".attr-cache"

214attrCacheFileName = ".attr-cache"

@@ -357,7 +356,7 @@ overwriteThunk target thunk = do

357 Right _ -> pure ()

356 Right _ -> pure ()

358

357

359 --TODO: Is there a safer way to do this overwriting?

358 --TODO: Is there a safer way to do this overwriting?

360− liftIO $ removePathForcibly target

359+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", target] -- target may be a symlink

361 createThunk target $ Right thunk

360 createThunk target $ Right thunk

362

361

363thunkPtrToSpec :: ThunkPtr -> ThunkSpec

362thunkPtrToSpec :: ThunkPtr -> ThunkSpec

@@ -410,6 +409,21 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

410 , confTrailingNewline = True

409 , confTrailingNewline = True

411 }

410 }

412

411

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+

413createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()

427createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()

414createThunk target ptrInfo =

428createThunk target ptrInfo =

415 ifor_ (_thunkSpec_files spec) $ \path -> \case

429 ifor_ (_thunkSpec_files spec) $ \path -> \case

@@ -541,7 +555,7 @@ let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256

541 inherit owner repo rev sha256 fetchSubmodules private;

555 inherit owner repo rev sha256 fetchSubmodules private;

542 };

556 };

543 json = builtins.fromJSON (builtins.readFile ./github.json);

557 json = builtins.fromJSON (builtins.readFile ./github.json);

544−in fetch json

558+in if builtins.pathExists ./local then ./local else fetch json

545|]

559|]

546

560

547parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

561parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -633,7 +647,7 @@ let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, pr

633 url = realUrl; inherit rev sha256;

647 url = realUrl; inherit rev sha256;

634 };

648 };

635 json = builtins.fromJSON (builtins.readFile ./git.json);

649 json = builtins.fromJSON (builtins.readFile ./git.json);

636−in fetch json

650+in if builtins.pathExists ./local then ./local else fetch json

637|]

651|]

638

652

639parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

653parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -645,7 +659,7 @@ mkThunkSpec name jsonFileName parser srcNix = ThunkSpec name $ Map.fromList

645 , ("thunk.nix", ThunkFileSpec_FileMatches srcNix)

659 , ("thunk.nix", ThunkFileSpec_FileMatches srcNix)

646 , (jsonFileName, ThunkFileSpec_Ptr parser)

660 , (jsonFileName, ThunkFileSpec_Ptr parser)

647 , (attrCacheFileName, ThunkFileSpec_AttrCache)

661 , (attrCacheFileName, ThunkFileSpec_AttrCache)

648− , (normalise $ unpackedDirName </> ".git", ThunkFileSpec_CheckoutIndicator)

662+ , (unpackedDirName, ThunkFileSpec_CheckoutIndicator)

649 ]

663 ]

650 where

664 where

651 defaultNixViaSrc = [here|

665 defaultNixViaSrc = [here|

@@ -685,7 +699,7 @@ nixBuildThunkAttrWithCache thunkSpec thunkDir attr = do

685 for cachePaths' $ \cachePaths ->

699 for cachePaths' $ \cachePaths ->

686 fmap NonEmpty.head $ for cachePaths $ \cacheDir -> do

700 fmap NonEmpty.head $ for cachePaths $ \cacheDir -> do

687 let

701 let

688− cachePath = thunkDir </> cacheDir </> attr <.> "out"

702+ cachePath = cacheDir </> attr <.> "out"

689 cacheErrHandler e

703 cacheErrHandler e

690 | isDoesNotExistError e = pure Nothing -- expected from a cache miss

704 | isDoesNotExistError e = pure Nothing -- expected from a cache miss

691 | otherwise = Nothing <$ putLog Error (T.pack $ displayException e)

705 | otherwise = Nothing <$ putLog Error (T.pack $ displayException e)

@@ -759,6 +773,9 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

759finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

773finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

760finalMsg noTrail s = if noTrail then Nothing else Just s

774finalMsg noTrail s = if noTrail then Nothing else Just s

761

775

776+unpackThunk :: MonadObelisk m => FilePath -> m ()

777+unpackThunk = unpackThunk' False

778+

762-- | Check that we are not somewhere inside the thunk directory

779-- | Check that we are not somewhere inside the thunk directory

763checkThunkDirectory :: MonadObelisk m => FilePath -> m ()

780checkThunkDirectory :: MonadObelisk m => FilePath -> m ()

764checkThunkDirectory thunkDir = do

781checkThunkDirectory thunkDir = do

@@ -773,9 +790,6 @@ checkThunkDirectory thunkDir = do

773 Right _ -> failWith [i|Refusing to perform thunk operation on ${thunkDir} because it is a thunk's unpacked source|]

790 Right _ -> failWith [i|Refusing to perform thunk operation on ${thunkDir} because it is a thunk's unpacked source|]

774 Left _ -> pure ()

791 Left _ -> pure ()

775

792

776−unpackThunk :: MonadObelisk m => FilePath -> m ()

777−unpackThunk = unpackThunk' False

778−

779unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()

793unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()

780unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkDir >>= \case

794unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkDir >>= \case

781 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]

795 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]

@@ -791,12 +805,9 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD

791 ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs

805 ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs

792 withSpinner' ("Fetching thunk " <> T.pack thunkName)

806 withSpinner' ("Fetching thunk " <> T.pack thunkName)

793 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

807 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

794− let unpackedPath = tmpThunk </> unpackedDirName

795− gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) unpackedPath

808+ gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) (tmpThunk </> unpackedDirName)

796

809

797− let normalizeMore = dropTrailingPathSeparator . normalise

798− when (normalizeMore unpackedPath /= normalizeMore tmpThunk) $ -- Only write meta data if the checkout is not inplace

799− createThunk tmpThunk $ Left newSpec

810+ createThunk tmpThunk $ Left newSpec

800

811

801 liftIO $ do

812 liftIO $ do

802 removePathForcibly thunkDir

813 removePathForcibly thunkDir

@@ -832,7 +843,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire

832 do

843 do

833 let checkClean = if force then CheckClean_NoCheck else CheckClean_FullCheck

844 let checkClean = if force then CheckClean_NoCheck else CheckClean_FullCheck

834 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr checkClean thunkDir (_thunkConfig_private thunkConfig)

845 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr checkClean thunkDir (_thunkConfig_private thunkConfig)

835− liftIO $ removePathForcibly thunkDir

846+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir] -- thunkDir may be a symlink

836 createThunk thunkDir $ Right thunkPtr

847 createThunk thunkDir $ Right thunkPtr

837 pure thunkPtr

848 pure thunkPtr

838

849

@@ -854,8 +865,7 @@ data CheckClean

854

865

855getThunkPtr :: forall m. MonadObelisk m => CheckClean -> FilePath -> Maybe Bool -> m ThunkPtr

866getThunkPtr :: forall m. MonadObelisk m => CheckClean -> FilePath -> Maybe Bool -> m ThunkPtr

856getThunkPtr gitCheckClean dir mPrivate = do

867getThunkPtr gitCheckClean dir mPrivate = do

857− let repoLocations = nubOrd $ map (first normalise)

858− [(".git", "."), (unpackedDirName </> ".git", unpackedDirName)]

868+ let repoLocations = [(".git", "."), (unpackedDirName, unpackedDirName)]

859 repoLocation' <- liftIO $ flip findM repoLocations $ doesDirectoryExist . (dir </>) . fst

869 repoLocation' <- liftIO $ flip findM repoLocations $ doesDirectoryExist . (dir </>) . fst

860 thunkDir <- case repoLocation' of

870 thunkDir <- case repoLocation' of

861 Nothing -> failWith [i|Can't find an unpacked thunk in ${dir}|]

871 Nothing -> failWith [i|Can't find an unpacked thunk in ${dir}|]

lib/command/src/Obelisk/Command/Utils.hs+2−34

@@ -54,38 +54,6 @@ 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−

89-- | Nix syntax requires relative paths to be prefixed by @./@ or

57-- | Nix syntax requires relative paths to be prefixed by @./@ or

90-- @../@. This will make a 'FilePath' that can be embedded in a Nix

58-- @../@. This will make a 'FilePath' that can be embedded in a Nix

91-- expression.

59-- expression.

@@ -123,7 +91,7 @@ initGit repo = do

123 git ["commit", "-m", "Initial commit."]

91 git ["commit", "-m", "Initial commit."]

124

92

125gitProcNoRepo :: [String] -> ProcessSpec

93gitProcNoRepo :: [String] -> ProcessSpec

126−gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc gitPath args

94+gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc "git" args

127

95

128gitProc :: FilePath -> [String] -> ProcessSpec

96gitProc :: FilePath -> [String] -> ProcessSpec

129gitProc repo = gitProcNoRepo . runGitInDir

97gitProc repo = gitProcNoRepo . runGitInDir

@@ -140,7 +108,7 @@ isolateGitProc = setEnvOverride (overrides <>)

140 , ("GIT_CONFIG_NOSYSTEM", "1")

108 , ("GIT_CONFIG_NOSYSTEM", "1")

141 , ("GIT_TERMINAL_PROMPT", "0") -- git 2.3+

109 , ("GIT_TERMINAL_PROMPT", "0") -- git 2.3+

142 , ("GIT_ASKPASS", "echo") -- pre git 2.3 to just use empty password

110 , ("GIT_ASKPASS", "echo") -- pre git 2.3 to just use empty password

143− , ("GIT_SSH_COMMAND", "ssh -o PreferredAuthentications=password -o PubkeyAuthentication=no -o GSSAPIAuthentication=no")

111+ , ("GIT_SSH_COMMAND", "ssh -o PreferredAuthentications password -o PubkeyAuthentication no -o GSSAPIAuthentication no")

144 ]

112 ]

145

113

146-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

114-- | 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, whichPath, sshKeygenPath, nixBuildExePath, dockerPath)

24+import Obelisk.Command.Utils (rmPath)

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 whichPath ["darwin-rebuild"]

38+ (exitCode, _, _) <- readCreateProcessWithExitCode $ proc "which" ["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 dockerPath ["container", "list", "--all", "--format", "{{.Names}}"]

70+ proc "docker" ["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 dockerPath ["start", containerName]

88+ proc "docker" ["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 sshKeygenPath ["-t", "ed25519", "-f", stateDir </> sshKeyFileName, "-P", ""]

101+ proc "ssh-keygen" ["-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 dockerPath ["build", stateDir, "--quiet"]

105+ proc "docker" ["build", stateDir, "--quiet"]

106− callProcessAndLogOutput (Debug, Error) $ proc dockerPath

106+ callProcessAndLogOutput (Debug, Error) $ proc "docker"

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 nixBuildExePath

158+ (exitCode, _stdout, stderr) <- readCreateProcessWithExitCode $ proc "nix-build"

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+2−15

@@ -19,25 +19,12 @@ 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"

24 '');

22 '');

25in

23in

26

24

27{

25{

28− haskellOverlay = self: super:

26+ haskellOverlay = self: super: {

29− let

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

31− in {

32− obelisk-executable-config-lookup = pkgs.haskell.lib.overrideCabal

33− (self.callCabal2nix "obelisk-executable-config-lookup" (obeliskCleanSource ./lookup) {})

27+ obelisk-executable-config-lookup = 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− });

41 };

28 };

42

29

43 platforms = {

30 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 -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

18+ ghc-options: -Wall

lib/executable-config/lookup/obelisk-executable-config-lookup.cabal+7−10

@@ -31,18 +31,15 @@ library

31 base64-bytestring,

32 bytestring,

33 containers,

34− exceptions,

35 filepath,

34 filepath,

36− jsaddle,

37− mmorph,

38− monad-control,

39− mtl,

40− primitive,

41− ref-tf,

42− reflex-dom-core,

43− reflex,

44 text,

35 text,

36+ transformers,

45 transformers-base,

37 transformers-base,

46− transformers

38+ ref-tf,

39+ primitive,

40+ monad-control,

41+ reflex,

42+ reflex-dom,

43+ jsaddle

47

44

48 ghc-options: -Wall

45 ghc-options: -Wall

lib/executable-config/lookup/src/Obelisk/Configs.hs+12−31

@@ -18,38 +18,24 @@ module Obelisk.Configs

18 , getTextConfig

19 ) where

20

21−import Control.Applicative (Alternative)

21+import Control.Applicative

22−import Control.Monad (MonadPlus)

22+import Control.Monad

23−import Control.Monad.Base (MonadBase)

23+import Control.Monad.Base

24−import Control.Monad.Catch (MonadThrow)

25−import Control.Monad.Fail (MonadFail)

26−import Control.Monad.Fix (MonadFix)

24+import Control.Monad.Fix

27−import Control.Monad.IO.Class (MonadIO)

28−import Control.Monad.Morph (MFunctor)

29−import Control.Monad.Primitive (PrimMonad, PrimState, primitive)

25+import Control.Monad.Primitive

30−import Control.Monad.Ref (MonadRef)

26+import Control.Monad.Ref

27+import Control.Monad.IO.Class

31−import Control.Monad.Trans (MonadTrans, lift)

28+import Control.Monad.Trans.Class

32−import Control.Monad.Trans.Control (MonadBaseControl)

29+import Control.Monad.Trans.Control

33−import Control.Monad.Trans.Reader (ReaderT (..), ask, mapReaderT)

30+import Control.Monad.Trans.Reader

34−import Control.Monad.Trans.State (StateT)

35−import qualified Control.Monad.Trans.State.Strict as Strict

36import Data.ByteString (ByteString)

31import Data.ByteString (ByteString)

37import Data.Map (Map)

32import Data.Map (Map)

38import qualified Data.Map as Map

33import qualified Data.Map as Map

39import Data.Text (Text)

34import Data.Text (Text)

40import qualified Data.Text.Encoding as T

35import qualified Data.Text.Encoding as T

41import Reflex

36import Reflex

42−import Reflex.Host.Class (MonadReflexCreateTrigger)

37+import Reflex.Host.Class

43−import Reflex.Dom.Core

38+import Reflex.Dom

44− ( DomBuilder

45− , DomRenderHook

46− , HasDocument

47− , HasJS

48− , HasJSContext

49− , Prerender (Client)

50− , StaticDomBuilderT

51− , prerender

52− )

53#ifndef ghcjs_HOST_OS

39#ifndef ghcjs_HOST_OS

54import Language.Javascript.JSaddle (MonadJSM)

40import Language.Javascript.JSaddle (MonadJSM)

55#endif

41#endif

@@ -76,8 +62,6 @@ instance HasConfigs m => HasConfigs (PostBuildT t m)

76instance HasConfigs m => HasConfigs (QueryT t q m)

62instance HasConfigs m => HasConfigs (QueryT t q m)

77instance HasConfigs m => HasConfigs (ReaderT r m)

63instance HasConfigs m => HasConfigs (ReaderT r m)

78instance HasConfigs m => HasConfigs (RequesterT t request response m)

64instance 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)

81instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

65instance HasConfigs m => HasConfigs (StaticDomBuilderT t m)

82instance HasConfigs m => HasConfigs (TriggerEventT t m)

66instance HasConfigs m => HasConfigs (TriggerEventT t m)

83

67

@@ -88,15 +72,12 @@ newtype ConfigsT m a = ConfigsT { unConfigsT :: ReaderT (Map Text ByteString) m

88 , Monad

72 , Monad

89 , MonadPlus

73 , MonadPlus

90 , Alternative

74 , Alternative

91− , MonadFail

92 , MonadFix

75 , MonadFix

93− , MonadThrow

94 , MonadIO

76 , MonadIO

95 , MonadBase m'

77 , MonadBase m'

96 , MonadBaseControl m'

78 , MonadBaseControl m'

97 , MonadRef

79 , MonadRef

98 , MonadTrans

80 , MonadTrans

99− , MFunctor

100 , DomBuilder t

81 , DomBuilder t

101 , MonadHold t

82 , MonadHold t

102 , MonadReflexCreateTrigger t

83 , 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 -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

29+ ghc-options: -Wall

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 (reviewEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

185+ let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (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.mddeleted−6

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

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+1−2

@@ -20,7 +20,6 @@ library

20 http-types,

21 jsaddle,

22 lens,

23− mmorph,

24 monad-control,

23 monad-control,

25 mtl,

24 mtl,

26 network-uri,

25 network-uri,

@@ -39,4 +38,4 @@ library

39 exposed-modules: Obelisk.Route

38 exposed-modules: Obelisk.Route

40 Obelisk.Route.TH

39 Obelisk.Route.TH

41 Obelisk.Route.Frontend

40 Obelisk.Route.Frontend

42− ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

41+ ghc-options: -Wall -fwarn-redundant-constraints

lib/route/src/Obelisk/Route.hs+48−92

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE ApplicativeDo #-}

1{-# LANGUAGE ApplicativeDo #-}

3{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE ConstraintKinds #-}

4{-# LANGUAGE EmptyCase #-}

3{-# LANGUAGE EmptyCase #-}

@@ -6,6 +5,7 @@

6{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE FlexibleInstances #-}

8{-# LANGUAGE GADTs #-}

7{-# LANGUAGE GADTs #-}

8+{-# LANGUAGE KindSignatures #-}

9{-# LANGUAGE LambdaCase #-}

10{-# LANGUAGE MultiParamTypeClasses #-}

11{-# LANGUAGE OverloadedStrings #-}

@@ -61,7 +61,6 @@ module Obelisk.Route

61 , justEncoder

62 , nothingEncoder

63 , isoEncoder

64− , viewEncoder

65 , wrappedEncoder

64 , wrappedEncoder

66 , unwrappedEncoder

65 , unwrappedEncoder

67 , listToNonEmptyEncoder

66 , listToNonEmptyEncoder

@@ -70,7 +69,6 @@ module Obelisk.Route

70 , toListMapEncoder

69 , toListMapEncoder

71 , shadowEncoder

70 , shadowEncoder

72 , prismEncoder

71 , prismEncoder

73− , reviewEncoder

74 , rPrism

72 , rPrism

75 , _R

73 , _R

76 , obeliskRouteEncoder

74 , obeliskRouteEncoder

@@ -135,24 +133,20 @@ import Control.Lens

135 , Prism'

133 , Prism'

136 , prism'

134 , prism'

137 , re

135 , re

138− , review

139 , view

136 , view

140 , Wrapped (..)

137 , Wrapped (..)

141 )

138 )

142import Control.Monad.Except

139import Control.Monad.Except

140+import Control.Monad.Writer (execWriter, tell)

143import qualified Control.Monad.State.Strict as State

141import qualified Control.Monad.State.Strict as State

144import Control.Monad.Trans (lift)

142import Control.Monad.Trans (lift)

145−import Control.Monad.Writer (execWriter, tell)

146−import Data.Aeson (FromJSON, ToJSON)

147−import qualified Data.Aeson as Aeson

148import qualified Data.ByteString as BS

143import qualified Data.ByteString as BS

149import qualified Data.ByteString.Lazy as BSL

144import qualified Data.ByteString.Lazy as BSL

145+import Data.Dependent.Sum (DSum (..))

150import Data.Dependent.Map (DMap)

146import Data.Dependent.Map (DMap)

151import qualified Data.Dependent.Map as DMap

147import qualified Data.Dependent.Map as DMap

152−import Data.Dependent.Sum (DSum (..))

153import Data.Either.Validation (Validation (..))

148import Data.Either.Validation (Validation (..))

154import Data.Foldable

149import Data.Foldable

155−import Data.Functor (($>))

156import Data.Functor.Sum

150import Data.Functor.Sum

157import Data.GADT.Compare

151import Data.GADT.Compare

158import Data.GADT.Compare.TH

152import Data.GADT.Compare.TH

@@ -165,18 +159,19 @@ import Data.Monoid ((<>))

165import Data.Set (Set)

159import Data.Set (Set)

166import qualified Data.Set as Set

160import qualified Data.Set as Set

167import Data.Some (Some(Some))

161import Data.Some (Some(Some))

168−import Data.Tabulation

169import Data.Text (Text)

162import Data.Text (Text)

163+import Data.Text.Lens (IsText, packed, unpacked)

170import qualified Data.Text as T

164import qualified Data.Text as T

171import qualified Data.Text.Encoding as T

165import qualified Data.Text.Encoding as T

172−import Data.Text.Lens (IsText, packed, unpacked)

173−import Data.Type.Equality

174import Data.Universe

166import Data.Universe

175import Data.Universe.Some

167import Data.Universe.Some

176import Network.HTTP.Types.URI

168import Network.HTTP.Types.URI

177import qualified Numeric.Lens

169import qualified Numeric.Lens

178import Obelisk.Route.TH

170import Obelisk.Route.TH

179import Text.Read (readMaybe)

171import Text.Read (readMaybe)

172+import Data.Tabulation

173+import qualified Data.Aeson as Aeson

174+import Data.Aeson (FromJSON, ToJSON)

180

175

181-- Design goals:

176-- Design goals:

182-- No start-up time on the frontend (not yet met)

177-- No start-up time on the frontend (not yet met)

@@ -226,19 +221,7 @@ hoistR f (x :=> Identity y) = f x :/ y

226infixr 5 :.

221infixr 5 :.

227type (:.) = (,)

222type (:.) = (,)

228

223

229−#ifdef __GLASGOW_HASKELL__

230−#if __GLASGOW_HASKELL__ >= 810

231{-# COMPLETE (:.) #-}

224{-# 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

242pattern (:.) :: a -> b -> a :. b

225pattern (:.) :: a -> b -> a :. b

243pattern a :. b = (a, b)

226pattern a :. b = (a, b)

244

227

@@ -304,13 +287,13 @@ decode e x = runIdentity (tryDecode e x)

304-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the

287-- | Once an 'Encoder' has been checked, so that its check monad has become 'Identity', even if the same is not true of the

305-- parse monad, we may still attempt to decode with it in its parse monad.

288-- parse monad, we may still attempt to decode with it in its parse monad.

306tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded

289tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded

307−tryDecode (Encoder (Identity impl)) = _encoderImpl_decode impl

290+tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x

308

291

309-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it

292-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it

310-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,

293-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,

311-- one should usually be applying decode and encode to the same 'Encoder'

294-- one should usually be applying decode and encode to the same 'Encoder'

312encode :: Encoder Identity parse decoded encoded -> decoded -> encoded

295encode :: Encoder Identity parse decoded encoded -> decoded -> encoded

313−encode (Encoder (Identity impl)) = _encoderImpl_encode impl

296+encode (Encoder (Identity impl)) x = _encoderImpl_encode impl x

314

297

315-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is

298-- | This is a primitive used to build encoders which can't fail to check. It should not be used unless one is

316-- reasonably certain that the law given for 'EncoderImpl' above holds.

299-- reasonably certain that the law given for 'EncoderImpl' above holds.

@@ -357,7 +340,7 @@ instance Monad parse => Bifunctor (,) (EncoderImpl parse) (EncoderImpl parse) (E

357 }

340 }

358

341

359instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

342instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

360− braid = viewEncoder (iso swap swap)

343+ braid = isoEncoder (iso swap swap)

361

344

362

345

363instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

346instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

@@ -393,11 +376,11 @@ instance (Monad parse, Applicative check) => Bifunctor Either (Encoder check par

393 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

376 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

394

377

395instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

378instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

396− associate = viewEncoder (iso (associate @(->) @Either) disassociate)

379+ associate = isoEncoder (iso (associate @(->) @Either) disassociate)

397− disassociate = viewEncoder (iso disassociate associate)

380+ disassociate = isoEncoder (iso disassociate associate)

398

381

399instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

382instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

400− braid = viewEncoder (iso swap swap)

383+ braid = isoEncoder (iso swap swap)

401

384

402

385

403

386

@@ -451,17 +434,17 @@ instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,)

451--------------------------------------------------------------------------------

434--------------------------------------------------------------------------------

452

435

453-- | Given a valid 'Iso' from lens, construct an 'Encoder'

436-- | Given a valid 'Iso' from lens, construct an 'Encoder'

454−viewEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

437+isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

455−viewEncoder f = unsafeMkEncoder $ EncoderImpl

438+isoEncoder f = unsafeMkEncoder $ EncoderImpl

456 { _encoderImpl_encode = view f

439 { _encoderImpl_encode = view f

457 , _encoderImpl_decode = pure . view (from f)

440 , _encoderImpl_decode = pure . view (from f)

458 }

441 }

459

442

460wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

443wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

461−wrappedEncoder = viewEncoder $ from _Wrapped'

444+wrappedEncoder = isoEncoder $ from _Wrapped'

462

445

463unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

446unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

464−unwrappedEncoder = viewEncoder $ _Wrapped'

447+unwrappedEncoder = isoEncoder _Wrapped'

465

448

466maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

449maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

467maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

450maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

@@ -486,11 +469,11 @@ maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder

486

469

487-- | Encode a value by simply applying 'Just'

470-- | Encode a value by simply applying 'Just'

488justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

471justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

489−justEncoder = reviewEncoder _Just

472+justEncoder = prismEncoder _Just

490

473

491-- | Encode () to 'Nothing'.

474-- | Encode () to 'Nothing'.

492nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

475nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

493−nothingEncoder = reviewEncoder _Nothing

476+nothingEncoder = prismEncoder _Nothing

494

477

495someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

478someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

496someConstEncoder = unsafeMkEncoder $ EncoderImpl

479someConstEncoder = unsafeMkEncoder $ EncoderImpl

@@ -555,11 +538,11 @@ pathComponentEncoder f = Encoder $ do

555 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')

538 unEncoder (pathComponentEncoderImpl (enum1Encoder (extractPathSegment . f)) f')

556

539

557pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)

540pathComponentEncoderImpl :: forall check parse p. (Monad check, Monad parse)

558− => Encoder check parse (Some p) (Maybe Text)

541+ => (Encoder check parse (Some p) (Maybe Text))

559 -> (forall a. p a -> Encoder Identity parse a PageName)

542 -> (forall a. p a -> Encoder Identity parse a PageName)

560 -> Encoder check parse (R p) PageName

543 -> Encoder check parse (R p) PageName

561−pathComponentEncoderImpl =

544+pathComponentEncoderImpl this rest =

562− chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder)

545+ chainEncoder (lensEncoder (\(_, b) a -> (a, b)) Prelude.fst consEncoder) this rest

563

546

564--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction

547--NOTE: Naming convention in this module is to always talk about things in the *encoding* direction, never in the *decoding* direction

565

548

@@ -815,7 +798,7 @@ rPrism

815 :: forall f f'

798 :: forall f f'

816 . (forall a. Prism' (f a) (f' a))

799 . (forall a. Prism' (f a) (f' a))

817 -> Prism' (R f) (R f')

800 -> Prism' (R f) (R f')

818−rPrism = dSumPrism

801+rPrism p = dSumPrism p

819

802

820dSumPrism'

803dSumPrism'

821 :: forall f g a

804 :: forall f g a

@@ -827,7 +810,7 @@ dSumGEqPrism

827 :: GEq f

810 :: GEq f

828 => f a

811 => f a

829 -> Prism' (DSum f g) (g a)

812 -> Prism' (DSum f g) (g a)

830−dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (geq variant)

813+dSumGEqPrism variant = dSumPrism' $ prism' (\Refl -> variant) (\x -> geq variant x)

831

814

832-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual

815-- | Given a 'tag :: f a', make a prism for 'R f'. This generalizes the usual

833-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'

816-- prisms for a sum type (the ones that 'mkPrisms' would make), just as 'R'

@@ -844,19 +827,12 @@ _R variant = dSumGEqPrism variant . iso runIdentity Identity

844

827

845-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

828-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

846-- if the prism doesn't match.

829-- 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@.

854−reviewEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

830+prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

855−reviewEncoder p = unsafeMkEncoder $ EncoderImpl

831+prismEncoder p = unsafeMkEncoder $ EncoderImpl

856− { _encoderImpl_encode = review p

832+ { _encoderImpl_encode = (^. re p)

857 , _encoderImpl_decode = \r -> case r ^? p of

833 , _encoderImpl_decode = \r -> case r ^? p of

858 Just a -> pure a

834 Just a -> pure a

859− Nothing -> throwError "reviewEncoder: value is not present in the prism"

835+ Nothing -> throwError "prismEncoder: value is not present in the prism"

860 }

836 }

861

837

862-- | A URL path and query string, in which trailing slashes don't matter in the path

838-- | A URL path and query string, in which trailing slashes don't matter in the path

@@ -994,9 +970,9 @@ obeliskRouteSegment r appRouteSegment = case r of

994-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.

970-- be combined with other such segment encoders before 'pathComponentEncoder' turns it into a proper 'Encoder'.

995resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a

971resourceRouteSegment :: (MonadError Text check, MonadError Text parse) => ResourceRoute a -> SegmentResult check parse a

996resourceRouteSegment = \case

972resourceRouteSegment = \case

997− ResourceRoute_Static -> PathSegment "static" pathOnlyEncoderIgnoringQuery

973+ ResourceRoute_Static -> PathSegment "static" $ pathOnlyEncoderIgnoringQuery

998− ResourceRoute_Ghcjs -> PathSegment "ghcjs" pathOnlyEncoder

974+ ResourceRoute_Ghcjs -> PathSegment "ghcjs" $ pathOnlyEncoder

999− ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" jsaddleWarpRouteEncoder

975+ ResourceRoute_JSaddleWarp -> PathSegment "jsaddle" $ jsaddleWarpRouteEncoder

1000 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty

976 ResourceRoute_Version -> PathSegment "version" $ unitEncoder mempty

1001

977

1002data JSaddleWarpRoute :: * -> * where

978data JSaddleWarpRoute :: * -> * where

@@ -1008,7 +984,7 @@ jsaddleWarpRouteEncoder :: (MonadError Text check, MonadError Text parse) => Enc

1008jsaddleWarpRouteEncoder = pathComponentEncoder $ \case

984jsaddleWarpRouteEncoder = pathComponentEncoder $ \case

1009 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty

985 JSaddleWarpRoute_JavaScript -> PathSegment "jsaddle.js" $ unitEncoder mempty

1010 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty

986 JSaddleWarpRoute_WebSocket -> PathEnd $ unitEncoder mempty

1011− JSaddleWarpRoute_Sync -> PathSegment "sync" pathOnlyEncoder

987+ JSaddleWarpRoute_Sync -> PathSegment "sync" $ pathOnlyEncoder

1012

988

1013instance GShow appRoute => GShow (ObeliskRoute appRoute) where

989instance GShow appRoute => GShow (ObeliskRoute appRoute) where

1014 gshowsPrec prec = \case

990 gshowsPrec prec = \case

@@ -1039,8 +1015,8 @@ someSumEncoder = Encoder $ pure $ EncoderImpl

1039

1015

1040data Void1 :: * -> * where {}

1016data Void1 :: * -> * where {}

1041

1017

1042−instance UniverseSome Void1 where

1018+instance Universe (Some Void1) where

1043− universeSome = []

1019+ universe = []

1044

1020

1045void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

1021void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a

1046void1Encoder = Encoder $ pure $ EncoderImpl

1022void1Encoder = Encoder $ pure $ EncoderImpl

@@ -1052,6 +1028,17 @@ void1Encoder = Encoder $ pure $ EncoderImpl

1052instance GShow Void1 where

1028instance GShow Void1 where

1053 gshowsPrec _ = \case {}

1029 gshowsPrec _ = \case {}

1054

1030

1031+concat <$> mapM deriveRouteComponent

1032+ [ ''ResourceRoute

1033+ , ''JSaddleWarpRoute

1034+ , ''IndexOnlyRoute

1035+ ]

1036+

1037+makePrisms ''ObeliskRoute

1038+makePrisms ''FullRoute

1039+deriveGEq ''Void1

1040+deriveGCompare ''Void1

1041+

1055-- | Given a backend route and a checked route encoder, render the route (path

1042-- | Given a backend route and a checked route encoder, render the route (path

1056-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1043-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1057renderBackendRoute

1044renderBackendRoute

@@ -1084,11 +1071,11 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>

1084readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1071readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1085

1072

1086integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1073integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1087−integralEncoder = reviewEncoder Numeric.Lens.integral

1074+integralEncoder = prismEncoder (Numeric.Lens.integral)

1088

1075

1089pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1076pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1090 Encoder check parse (a, (as, b)) (as, b)

1077 Encoder check parse (a, (as, b)) (as, b)

1091−pathSegmentEncoder = first (reviewEncoder _Cons) . disassociate

1078+pathSegmentEncoder = first (prismEncoder _Cons) . disassociate

1092

1079

1093newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1080newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1094

1081

@@ -1159,7 +1146,7 @@ pathFieldEncoder fieldEncoder = unsafeEncoder $ do

1159 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)

1146 fieldEncoderPure f = toEncoder (DMap.findWithDefault (error "bad") f fieldEncoderPureMap)

1160 pure $ EncoderImpl

1147 pure $ EncoderImpl

1161 { _encoderImpl_encode = \(x, rest) -> execWriter $ do

1148 { _encoderImpl_encode = \(x, rest) -> execWriter $ do

1162− _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) $> x_i) x

1149+ _ <- traverseWithField (\f x_i -> tell (pure $ encode (fieldEncoderPure f) x_i) *> pure x_i) x

1163 tell rest

1150 tell rest

1164 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case

1151 , _encoderImpl_decode = State.runStateT $ tabulateFieldsA $ \f -> State.get >>= \case

1165 [] -> throwError $ T.pack "not enough path components"

1152 [] -> throwError $ T.pack "not enough path components"

@@ -1195,34 +1182,3 @@ byteStringsToPageName p q =

1195 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1182 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1196

1183

1197--TODO: decodeURIComponent as appropriate

1184--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+28−41

@@ -1,24 +1,24 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE ApplicativeDo #-}

1{-# LANGUAGE ApplicativeDo #-}

2+{-# LANGUAGE CPP #-}

3+{-# LANGUAGE RecursiveDo #-}

4+{-# LANGUAGE StandaloneDeriving #-}

3{-# LANGUAGE ConstraintKinds #-}

5{-# LANGUAGE ConstraintKinds #-}

4−{-# LANGUAGE DataKinds #-}

5{-# LANGUAGE DefaultSignatures #-}

6{-# LANGUAGE DefaultSignatures #-}

6{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleInstances #-}

8{-# LANGUAGE FlexibleInstances #-}

8−{-# LANGUAGE FunctionalDependencies #-}

9{-# LANGUAGE GADTs #-}

10−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

11{-# LANGUAGE LambdaCase #-}

10{-# LANGUAGE LambdaCase #-}

12{-# LANGUAGE OverloadedStrings #-}

11{-# LANGUAGE OverloadedStrings #-}

13{-# LANGUAGE PatternSynonyms #-}

12{-# LANGUAGE PatternSynonyms #-}

14{-# LANGUAGE RankNTypes #-}

13{-# LANGUAGE RankNTypes #-}

15−{-# LANGUAGE RecursiveDo #-}

16{-# LANGUAGE ScopedTypeVariables #-}

14{-# LANGUAGE ScopedTypeVariables #-}

17−{-# LANGUAGE StandaloneDeriving #-}

18{-# LANGUAGE TypeFamilies #-}

15{-# LANGUAGE TypeFamilies #-}

19{-# LANGUAGE TypeOperators #-}

16{-# LANGUAGE TypeOperators #-}

20−{-# LANGUAGE UndecidableInstances #-}

21{-# LANGUAGE ViewPatterns #-}

17{-# LANGUAGE ViewPatterns #-}

18+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

19+{-# LANGUAGE UndecidableInstances #-}

20+{-# LANGUAGE DataKinds #-}

21+{-# LANGUAGE FunctionalDependencies #-}

22

23module Obelisk.Route.Frontend

24 ( module Obelisk.Route

@@ -57,42 +57,49 @@ module Obelisk.Route.Frontend

57

58import Prelude hiding ((.), id)

59

60+import Obelisk.Route

61+

60import Control.Category (Category (..), (.))

62import Control.Category (Category (..), (.))

61import Control.Category.Cartesian ((&&&))

63import Control.Category.Cartesian ((&&&))

62import Control.Lens hiding (Bifunctor, bimap, universe, element)

64import Control.Lens hiding (Bifunctor, bimap, universe, element)

63import Control.Monad ((<=<))

65import Control.Monad ((<=<))

64import Control.Monad.Fix

66import Control.Monad.Fix

65−import Control.Monad.Morph

66import Control.Monad.Primitive

67import Control.Monad.Primitive

67import Control.Monad.Reader

68import Control.Monad.Reader

68import Control.Monad.Ref

69import Control.Monad.Ref

69import Control.Monad.Trans.Control

70import Control.Monad.Trans.Control

70import Data.Coerce

71import Data.Coerce

71import Data.Dependent.Sum (DSum (..))

72import Data.Dependent.Sum (DSum (..))

72−import Data.Functor.Compose

73−import Data.Functor.Misc

74import Data.GADT.Compare

73import Data.GADT.Compare

75−import qualified Data.List as L

76import Data.Map (Map)

74import Data.Map (Map)

77−import Data.Maybe (fromMaybe)

78import Data.Monoid

75import Data.Monoid

79import Data.Proxy

76import Data.Proxy

80import Data.Text (Text)

77import Data.Text (Text)

81import qualified Data.Text as T

78import 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

82import Data.Type.Coercion

90import Data.Type.Coercion

91+import Language.Javascript.JSaddle --TODO: Get rid of this - other platforms can also be routed

92+import Reflex.Dom.Core

83import qualified GHCJS.DOM as DOM

93import qualified GHCJS.DOM as DOM

84import qualified GHCJS.DOM.Types as DOM

94import qualified GHCJS.DOM.Types as DOM

85import qualified GHCJS.DOM.Window as Window

95import 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

87import Network.URI

96import Network.URI

88−import Reflex.Class

97+import Data.Maybe (fromMaybe)

89−import Reflex.Dom.Builder.Class

98+import qualified Data.List as L

90−import Reflex.Dom.Core

99+

91−import Reflex.Host.Class

92import Unsafe.Coerce

100import Unsafe.Coerce

93

101

94import Obelisk.Configs

102import Obelisk.Configs

95−import Obelisk.Route

96

103

97infixr 5 :~

104infixr 5 :~

98pattern (:~) :: Reflex t => f a -> Dynamic t a -> DSum f (Compose (Dynamic t) Identity)

105pattern (:~) :: Reflex t => f a -> Dynamic t a -> DSum f (Compose (Dynamic t) Identity)

@@ -109,23 +116,7 @@ instance Monad m => Routed t r (RoutedT t r m) where

109instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)

116instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)

110

117

111newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

118newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

112− deriving

119+ deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)

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− )

129

120

130instance MonadReader r' m => MonadReader r' (RoutedT t r m) where

121instance MonadReader r' m => MonadReader r' (RoutedT t r m) where

131 ask = lift ask

122 ask = lift ask

@@ -201,10 +192,6 @@ instance (Monad m, RouteToUrl r m) => RouteToUrl r (EventWriterT t w m)

201

192

202instance (Monad m, SetRoute t r m) => SetRoute t r (EventWriterT t w m)

193instance (Monad m, SetRoute t r m) => SetRoute t r (EventWriterT t w m)

203

194

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−

208runRoutedT :: RoutedT t r m a -> Dynamic t r -> m a

195runRoutedT :: RoutedT t r m a -> Dynamic t r -> m a

209runRoutedT = runReaderT . unRoutedT

196runRoutedT = runReaderT . unRoutedT

210

197

@@ -269,7 +256,7 @@ dynamicIdentityCoercion = unsafeCoerce (Coercion :: Coercion (Identity ()) ()) -

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

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

270factorRouted r = RoutedT $ ReaderT $ \d -> do

257factorRouted r = RoutedT $ ReaderT $ \d -> do

271 d' <- factorDyn d

258 d' <- factorDyn d

272− runRoutedT r $ coerceWith (dynamicCoercion $ dsumValueCoercion dynamicIdentityCoercion) d'

259+ runRoutedT r $ (coerceWith (dynamicCoercion $ dsumValueCoercion dynamicIdentityCoercion) d')

273

260

274maybeRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Maybe (Dynamic t a)) m b -> RoutedT t (Maybe a) m b

261maybeRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Maybe (Dynamic t a)) m b -> RoutedT t (Maybe a) m b

275maybeRouted r = RoutedT $ ReaderT $ \d -> do

262maybeRouted r = RoutedT $ ReaderT $ \d -> do

@@ -477,7 +464,7 @@ runRouteViewT

477 , MonadJSM (Performable m)

464 , MonadJSM (Performable m)

478 , MonadFix m

465 , MonadFix m

479 )

466 )

480− => Encoder Identity Identity r PageName

467+ => (Encoder Identity Identity r PageName)

481 --TODO: Get rid of the switchover and useHash arguments

468 --TODO: Get rid of the switchover and useHash arguments

482 -- useHash can probably be baked into the encoder

469 -- useHash can probably be baked into the encoder

483 -> Event t () -- ^ Switchover event, nothing is done until this event fires. Used to prevent incorrect DOM expectations at hydration switchover time

470 -> 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-core

36+ , reflex-dom

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 -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

50+ ghc-options: -Wall -fwarn-redundant-constraints

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− timenow <- getCurrentTime

147+ now <- getCurrentTime

148− _ <- X509.setNotBefore cert $ addUTCTime (-1) timenow

148+ _ <- X509.setNotBefore cert $ addUTCTime (-1) now

149− _ <- X509.setNotAfter cert $ addUTCTime (365 * 24 * 60 * 60) timenow

149+ _ <- X509.setNotAfter cert $ addUTCTime (365 * 24 * 60 * 60) now

150 _ <- X509.signX509 cert privateKey Nothing

151

152 certByteString <- BSUTF8.fromString <$> PEM.writeX509 cert

lib/selftest/src/Obelisk/SelfTest.hs+7−25

@@ -19,7 +19,6 @@ import Data.Bool (bool)

19import qualified Data.ByteString.Lazy as LBS

20import Data.Foldable (for_)

21import Data.Function (fix)

22−import Data.List (isInfixOf)

23import qualified Data.Map as Map

22import qualified Data.Map as Map

24import Data.Semigroup ((<>))

23import Data.Semigroup ((<>))

25import qualified Data.Set as Set

24import qualified Data.Set as Set

@@ -206,22 +205,6 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

206 it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager

205 it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager

207 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

206 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

208

207

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−

225 describe "obelisk project" $ parallel $ do

208 describe "obelisk project" $ parallel $ do

226 it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]

209 it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]

227 it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]

210 it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]

@@ -260,8 +243,6 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

260 uu <- update

243 uu <- update

261 assertRevEQ u uu

244 assertRevEQ u uu

262

245

263− it "can run 'ob doc'" $ inTmpObInit $ \_ -> runOb_ ["doc", "reflex"]

264−

265 describe "ob thunk pack/unpack" $ parallel $ do

246 describe "ob thunk pack/unpack" $ parallel $ do

266 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

247 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

267

248

@@ -323,11 +304,6 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

323 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

304 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

324 checkDir dir >>= liftIO . assertEqual "" startingContents

305 checkDir dir >>= liftIO . assertEqual "" startingContents

325

306

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−

331 describe "ob hoogle" $ {- NOT parallel -} do

307 describe "ob hoogle" $ {- NOT parallel -} do

332 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

308 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

333 [p0] <- liftIO $ getFreePorts 1

309 [p0] <- liftIO $ getFreePorts 1

@@ -360,6 +336,7 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

360 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

336 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

361 () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"

337 () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"

362 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

338 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

339+ runOb_ ["thunk", "init", toTextIgnore obeliskImpl]

363 f obeliskImpl

340 f obeliskImpl

364

341

365 withInitCache f =

342 withInitCache f =

@@ -521,9 +498,14 @@ testLegacyGitThunks isVerbose = withSystemTempDirectory "test-git-repo" $ \gitDi

521

498

522 for_ (legacyGitThunks (GitThunkParams gitDir rev sha256)) $ \mkFiles ->

499 for_ (legacyGitThunks (GitThunkParams gitDir rev sha256)) $ \mkFiles ->

523 withSystemTempDirectory "test-thunks" $ \thunkDir -> do

500 withSystemTempDirectory "test-thunks" $ \thunkDir -> do

501+ let nixEval = run nixInstantiatePath ["--eval", toTextIgnore (thunkDir </> ("thunk.nix" :: FilePath))]

524 liftIO $ mkFiles thunkDir

502 liftIO $ mkFiles thunkDir

525 run_ "ob" ["thunk", "unpack", toTextIgnore thunkDir]

503 run_ "ob" ["thunk", "unpack", toTextIgnore thunkDir]

504+ unpackedEval <- nixEval

526 run_ "ob" ["thunk", "pack", toTextIgnore thunkDir]

505 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

527

509

528data GitThunkParams = GitThunkParams

510data GitThunkParams = GitThunkParams

529 { _gitThunkParams_repo :: !FilePath

511 { _gitThunkParams_repo :: !FilePath

@@ -623,4 +605,4 @@ legacyGitThunks (GitThunkParams repo' rev sha256) =

623 LBS.writeFile (dir </> ("git.json" :: FilePath)) (Aeson.encode gitJson)

605 LBS.writeFile (dir </> ("git.json" :: FilePath)) (Aeson.encode gitJson)

624

606

625unpackedDirName :: FilePath

607unpackedDirName :: FilePath

626−unpackedDirName = "."

608+unpackedDirName = "local"

lib/snap-extras/obelisk-snap-extras.cabal+2−1

@@ -12,9 +12,10 @@ library

12 , base

13 , bytestring

14 , snap-core

15+ , unix

15 , directory

16 , directory

16 , filepath

17 , filepath

17 , text

18 , text

18 exposed-modules:

19 exposed-modules:

19 Obelisk.Snap.Extras

20 Obelisk.Snap.Extras

20− ghc-options: -Wall -Werror -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O

21+ ghc-options: -Wall

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, immutable"

20+ modifyResponse $ setHeader "Cache-Control" "public, max-age=315360000"

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-libnew file+4

@@ -0,0 +1,4 @@

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+6−12

@@ -1,15 +1,9 @@

1+dist-newstyle

2+result

3+result-*

4+result-android

5+result-ios

6+result-exe

1.attr-cache

7.attr-cache

2−.cabal-sandbox

3−*.hi

4−*.o

5−cabal.project.local

6−cabal.sandbox.config

7−ctags

8−dist-newstyle/

9−dist/

10ghcid-output.txt

8ghcid-output.txt

11profile/

9profile/

12−result

13−result-*

14−tags

15−TAGS

skeleton/backend/backend.cabal+1−2

@@ -14,12 +14,11 @@ library

14 , obelisk-route

15 exposed-modules:

16 Backend

17− ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

17+ ghc-options: -Wall

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

23 if impl(ghcjs)

22 if impl(ghcjs)

24 buildable: False

23 buildable: False

25 build-depends: base

24 build-depends: base

skeleton/cabal.project−1

@@ -1,3 +1,2 @@

1optional-packages:

2 *

3−write-ghc-environment-files: never

skeleton/common/common.cabal−1

@@ -12,4 +12,3 @@ 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+3−10

@@ -1,17 +1,10 @@

1−{ system ? builtins.currentSystem

2−, obelisk ? import ./.obelisk/impl {

1+{ obelisk ? import ./.obelisk/impl {

3− inherit system;

2+ system = builtins.currentSystem;

4− iosSdkVersion = "13.2";

3+ iosSdkVersion = "10.2";

5−

6 # You must accept the Android Software Development Kit License Agreement at

4 # You must accept the Android Software Development Kit License Agreement at

7 # https://developer.android.com/studio/terms in order to build Android apps.

5 # https://developer.android.com/studio/terms in order to build Android apps.

8 # Uncomment and set this to `true` to indicate your acceptance:

6 # Uncomment and set this to `true` to indicate your acceptance:

9 # config.android_sdk.accept_license = false;

7 # 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;

15 }

8 }

16}:

9}:

17with obelisk;

10with obelisk;

skeleton/frontend/frontend.cabal+4−6

@@ -16,7 +16,7 @@ library

16 , text

17 exposed-modules:

18 Frontend

19− ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

19+ ghc-options: -Wall

20

21executable frontend

22 main-is: main.hs

@@ -28,9 +28,7 @@ executable frontend

28 , reflex-dom

29 , obelisk-generated-static

30 , frontend

31− ghc-options: -threaded -O -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -fno-show-valid-hole-fits

31+ --TODO: Make these ghc-options optional

32− if impl(ghcjs)

32+ ghc-options: -threaded

33− ghc-options: -dedupe

34− cpp-options: -DGHCJS_BROWSER

35 if os(darwin)

33 if os(darwin)

36− ghc-options: -dynamic

34+ ghc-options: -dynamic

skeleton/shell.nixnew file+1

@@ -0,0 +1 @@

1+(import ./. {}).shells.ghc