on master help sign in
Merge remote-tracking branch 'origin/develop' into ae@backend-customization
commit12728f77f0fe0a6c14e303ff18c4557195798723 authorElliot Cameron <eacameron@gmail.com> dateMon 16 Mar 2020, 17:08 (7 years ago) parent847d6779545790
28 files changed+666−256
.github/pull_request_template.md+1−1 ChangeLog.md+37 LICENSE+30 README.md+45−19 all-builds.nix+2−4 default.nix+65−21 dep/gitignore.nix/default.nix+8 dep/gitignore.nix/github.json+8 dep/reflex-platform/github.json+3−3 dep/snap-core/default.nix+8 dep/snap-core/github.json+8 lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+14−4 lib/backend/src/Obelisk/Backend.hs+87−34 lib/cliapp/src/Obelisk/CliApp.hs+1 lib/cliapp/src/Obelisk/CliApp/Process.hs+8−3 lib/command/obelisk-command.cabal+1−2 lib/command/src/Obelisk/Command.hs+25−3 lib/command/src/Obelisk/Command/Deploy.hs+61−60 lib/command/src/Obelisk/Command/Nix.hs+21−11 lib/command/src/Obelisk/Command/Project.hs+26−6 lib/command/src/Obelisk/Command/Run.hs+84−43 lib/command/src/Obelisk/Command/Thunk.hs+22−2 lib/command/src/Obelisk/Command/Utils.hs+3 lib/frontend/src/Obelisk/Frontend.hs+6−6 lib/route/src/Obelisk/Route/Frontend.hs+80−16 lib/run/src/Obelisk/Run.hs+11−6 lib/selftest/src/Obelisk/SelfTest.hs−12 skeleton/.gitignore+1
.github/pull_request_template.md+1−1
@@ -1,4 +1,4 @@
1−[Provide a clear overview of your changes.]
1+<!-- Provide a clear overview of your changes. -->
22
33I have:
44
ChangeLog.md+37
@@ -4,10 +4,33 @@ This project's release branch is `master`. This log is written from the perspect
44
55## Unreleased
66
7+* Fully support HTTP [Range](https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Range) requests on static assets to support Safari. ([#664](https://github.com/obsidiansystems/obelisk/pull/664))
8+* Support non-EC2 deployments. ([#658](https://github.com/obsidiansystems/obelisk/pull/658))
9+* Fix `ob deploy test android` to work. ([#645](https://github.com/obsidiansystems/obelisk/pull/645))
10+* Fix vulnerability where Android deployments would leave signing keys in the nix store which is world readable. ([#645](https://github.com/obsidiansystems/obelisk/pull/645)) (Thanks to [kmicklas](https://github.com/kmicklas) for the report.)
11+* Add `Obelisk.Backend.runBackendWith` to allow customization of how GHCJS resources are loaded in the page. ([#668](https://github.com/obsidiansystems/obelisk/pull/668))
12+* Add `ob profile` command to run Obelisk projects with profiling. `ob profile` works like `ob run`, but instead of using `ghci`, it builds an executable that is built with profiling enabled. ([#654](https://github.com/obsidiansystems/obelisk/pull/654))
13+
14+## v0.6.0.0 - 2020-02-21
15+
16+* Fix a bug in `Obelisk.Route.Frontend` where `routeLink`, `routeLinkDynAttr`, and `dynRouteLink` would not behave exactly like `<a href="...">` when run by JavaScript. These functions now scroll to the top of the page when the link is clicked. ([#540](https://github.com/obsidiansystems/obelisk/pull/540))
17+* Fix a bug in `ob run`/`ob watch`/`ob repl` where nested Obelisk projects would also be loaded into the session. These are now ignored. ([#652](https://github.com/obsidiansystems/obelisk/pull/652))
18+* Improve behavior of `ob run`/`ob watch`/`ob repl` when multiple packages with the same name are encountered. Obelisk now issues a warning and tells you which one it will use. ([#653](https://github.com/obsidiansystems/obelisk/pull/653))
19+* Removed `Obelisk.Backend.mkRouteToUrl` since it is easily written in terms of `Obelisk.Route.renderObeliskRoute`:
20+
21+ mkRouteToUrl validFullEncoder (k :/ v) = renderObeliskRoute validFullEncoder (FullRoute_Frontend (ObeliskRoute_App k) :/ v)
22+
23+* Add `Obelisk.Backend.renderAllJsPath` to expose URL path to `ghcjs/all.js`. ([#545](https://github.com/obsidiansystems/obelisk/pull/545))
24+* Add argument to `serveDefaultObeliskApp`, `serveObeliskApp`, and `serveGhcjsApp` to take the path to `all.js` instead of hard-coding it. ([#545](https://github.com/obsidiansystems/obelisk/pull/545))
25+
26+## v0.5.0.0 - 2020-02-07
27+
728* Add `Obelisk.Route.(?/)`, a convenience function for constructing routes nested in `Maybe`. ([#457](https://github.com/obsidiansystems/obelisk/pull/457))
829* Add local unpacked packages to the `ob run`, `ob watch`, and `ob repl` sessions. Any `.cabal` or hpack package inside the current obelisk project will be loaded into the session. For `ob run`/`ob watch` this means the session will automatically reload when you save a source file in any of those packages. For `ob repl` it means that `:r` will reload changes to any of those packages. There are some edge cases where this integration is still rough. Report any issues you encounter. ([#489](https://github.com/obsidiansystems/obelisk/pull/489))
930* Add `ob hoogle` command to start a local [Hoogle](https://hoogle.haskell.org/) server for the project. ([#628](https://github.com/obsidiansystems/obelisk/pull/628))
1031* `ob thunk pack` will now attempt to automatically detect if the thunk is a private or public repo. To avoid this detection, specify `--private` or `--public` manually. ([#607](https://github.com/obsidiansystems/obelisk/pull/607))
32+* Fix a bug in the plain git thunk loader for thunks marked as 'private' when the revision is not in the default branch. ([#648](https://github.com/obsidiansystems/obelisk/pull/648))
33+* Improve handling of runtime nix dependencies. This may fix some issues encountered particularly by users on systems other than NixOS.
1134
1235## v0.4.0.0 - 2020-01-10
1336
@@ -22,6 +45,20 @@ This project's release branch is `master`. This log is written from the perspect
2245
2346## v0.3.0.0 - 2019-12-20
2447
48+* Change the structure of Obelisk routes to use a designated
49+ `FullRoute` type. This combines frontend and backend routes into one
50+ structure. This is a **breaking** change which requires Obelisk apps
51+ to take specific migrations. They are:
52+ * Rewrite the implementation of `_backend_routeEncoder` in
53+ `Backend` to use `mkFullRouteEncoder` instead of
54+ `handleEncoder`. Specifically, the backend and frontend cases of
55+ the top-level `pathComponentEncoder` become the second and third
56+ arguments of `mkFullRouteEncoder` respectively, while the
57+ missing route becomes the first argument. An example of how to
58+ do this is available in [a reflex-examples
59+ commit](https://github.com/reflex-frp/reflex-examples/commits/28f566c3e7dc615578dc74297b7c620c1f13683e).
60+ * Replace type constructions of `InL` with `FullRoute_Backend` and
61+ `InR` with `FullRoute_Frontend`.
2562* Generalised `pathSegmentEncoder`, added `pathFieldEncoder`.
2663* Added some `Prism`s to the encoder library for manipulating `DSum`s.
2764* Add `ob doc` command, which lists paths to haddock documentation for specified packages.
LICENSEnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c) 2020 Obsidian Systems
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Elliot Cameron nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md+45−19
@@ -1,5 +1,9 @@
11# Obelisk
22
3+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org)
4+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)
5+
6+
37Obelisk provides an easy way to develop and deploy your [Reflex](https://github.com/reflex-frp/reflex) project as web apps and as mobile apps.
48
59- [Installing Obelisk](#installing-obelisk)
@@ -9,7 +13,9 @@ Obelisk provides an easy way to develop and deploy your [Reflex](https://github.
913 - [Running over https](#running-over-https)
1014- [Deploying](#deploying)
1115 - [Locally](#locally)
12− - [EC2](#ec2)
16+ - [Default EC2 Deployment](#default-ec2-deployment)
17+ - [Custom Non-EC2 Deployment](#custom-non-ec2-deployment)
18+ - [VirtualBox Deployment](#virtualbox-deployment)
1319 - [From macOS](#from-macos)
1420 - [Deploying an updated version](#deploying-an-updated-version)
1521- [Mobile](#mobile)
@@ -51,24 +57,24 @@ Obelisk provides an easy way to develop and deploy your [Reflex](https://github.
5157
5258When developing on obelisk itself you may launch `ghcid` for the corresponding project as follows. For example to launch ghcid for `lib/backend` project:
5359
54−```
60+```bash
5561nix-shell -A obeliskEnvs.obelisk-backend --run "cd lib/backend && ghcid -c 'cabal new-repl'"
5662```
5763
5864Or to launch ghcid for `lib/command` project:
5965
60−```
66+```bash
6167nix-shell -A obeliskEnvs.obelisk-command --run "cd lib/command && ghcid -c 'cabal new-repl'"
6268```
6369
6470To re-install `ob` from source do
65−```
71+```bash
6672nix-env -f /path/to/obelisk -iA command
6773```
6874
6975Note that `ob` will defer to the version found in your project's `.obelisk/impl` directory. To update that version specifically:
7076
71−```shell
77+```bash
7278ob thunk unpack ./.obelisk/impl
7379cd ./.obelisk/impl
7480# apply your changes
@@ -76,7 +82,7 @@ cd ./.obelisk/impl
7682
7783If you want to commit your changes, first push them to your fork of obelisk and then
7884
79−```shell
85+```bash
8086cd /your/project/root
8187ob thunk pack .obelisk/impl
8288git add .obelisk/impl
@@ -96,13 +102,13 @@ access to:
96102
97103To create a new Obelisk project, go to an empty directory and run:
98104
99−```
105+```bash
100106ob init
101107```
102108
103109Obelisk leverages ghcid to provide a live-reloading server that handles both frontend and backend. To run your Obelisk app and monitor the source for changes:
104110
105−```
111+```bash
106112ob run
107113```
108114
@@ -161,7 +167,7 @@ project ./. ({ pkgs, ... }: {
161167# ...
162168```
163169
164−### Running over https
170+### Running over HTTPS
165171
166172To run your app locally over https, update the protocol in `config/common/route` to `https`, and then use `ob run` as normal.
167173
@@ -173,22 +179,22 @@ Since Obelisk generates a self-signed certificate for running https, the browser
173179
174180Build everything:
175181
176−```
182+```bash
177183nix-build -A exe --no-out-link
178184```
179185
180186Copy the result to a new directory, add configuration, and run!
181187
182−```
188+```bash
183189mkdir test-app
184190ln -s $(nix-build -A exe --no-out-link)/* test-app/
185191cp -r config test-app
186192(cd test-app && ./backend)
187193```
188194
189−### EC2
195+### Default EC2 Deployment
190196
191−In this section we will demonstrate how to deploy your Obelisk app to an Amazon EC2 instance.
197+In 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)).
192198
193199First create a new EC2 instance:
194200
@@ -215,7 +221,7 @@ ob deploy init \
215221 ~/code/myapp-deploy
216222```
217223
218−HTTPS is enabled by default; to disable https, pass `--disable-https` to the `ob deploy init` command above.
224+HTTPS is enabled by default; to disable HTTPS pass `--disable-https` to the `ob deploy init` command above.
219225
220226This step will also require that you manually verify the authenticity of the host `$SERVER`. Obelisk will save the fingerprint in a deployment-specific configuration. **Obelisk deployments do *not* rely on the `known_hosts` of your local machine.** This is because, in the event that you need to switch from one deploy machine / bastion host to another, you want to be absolutely sure that you're still connecting to the machines you think you are, even if that deploy machine / bastion host has never connected to them before. Obelisk explicitly avoids a workflow that encourages people to accept host keys without checking them, since that could result in leaking production secrets to anyone who manages to MITM you, e.g. via DNS spoofing or cache poisoning. (Note that an active attack is a circumstance where you may need to quickly switch bastion hosts, e.g. because the attacker has taken one down or you have taken it down in case it was compromised. In this circumstance you might need to deploy to production to fix an exploit or rotate keys, etc.) When you run `ob deploy` later it will rely on the saved verification in this step.
221227
@@ -230,6 +236,26 @@ ob deploy push
230236
231237At this point you are done. Your app will be accessible at `${ROUTE}`. The currently deployed version - the git commit hash of the source repo - can be found at `${ROUTE}/version`.
232238
239+### Custom Non-EC2 Deployment
240+
241+By default Obelisk deployments are configured for NixOS machines running on AWS EC2. To provide your own configuration, you need to write a custom `module.nix` in the deployment repository. This still requires that your server is running NixOS.
242+
243+`module.nix` must contain a Nix *function* that produces a [NixOS module function](https://nixos.org/nixos/manual/index.html#sec-writing-modules). The top-level function takes deployment configuration as arguments: `hostName`, `adminEmail`, `routeHost`, `enableHttps`, `version`, `exe`, `nixosPkgs`. Most of these are the values you specified during `ob deploy init` and are stored in the deployment repository. `version` is a `git` hash for the app that you're deploying. `exe` is the Linux build of the app (as seen in [Deploying Locally](#locally)). `nixosPkgs` is the package set used to construct the NixOS VM.
244+
245+The [VirtualBox Deployment](#virtualbox-deployment) section provides an example.
246+
247+#### VirtualBox Deployment
248+
249+Here's a `module.nix` that is configured for deployment to a VirtualBox VM (running NixOS):
250+
251+```nix
252+{ nixosPkgs, ... }: {...}: {
253+ imports = [ (nixosPkgs.path + /nixos/modules/virtualisation/virtualbox-image.nix) ];
254+}
255+```
256+
257+The `{...}:` and following is the [NixOS module](https://nixos.org/nixos/manual/index.html#sec-writing-modules) definition.
258+
233259### From macOS
234260
235261Deploying from macOS requires some extra setup:
@@ -243,7 +269,7 @@ Running `ob deploy push` will give you additional setup instructions.
243269
244270If you'd like to deploy an updated version (with new commits) of your Obelisk app: simply go to the configuration directory, update the source thunk and push:
245271
246−```
272+```bash
247273cd ~/code/myapp-deploy
248274ob deploy update
249275ob deploy push
@@ -269,14 +295,14 @@ These versions will work out of the box but iOS SDKs prior to 11.3 should also w
269295
270296More recent Xcodes should also work, as long as one of the SDKs mentioned above has been used.
271297To add another SDK to your current Xcode, [download](https://developer.apple.com/download/more/) the corresponding Xcode, extract it and copy its SDK folder next to the installed one, e.g.
272−```
298+```bash
273299open -W Xcode_9.2.xip
274300sudo cp -R Xcode.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS.sdk /Applications/Xcode.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS11.2.sdk
275301```
276302
277303
278304You can verify that you have correct versions by running
279−```
305+```bash
280306xcodebuild -showsdks
281307```
282308
@@ -302,7 +328,7 @@ Ensure that `bundleIdentifier` matches the App ID of the development profile, or
3023281. Connect the registered iPhone.
3033291. Find your Apple Team ID in the [developer portal](https://developer.apple.com/account/#/membership).
3043301. Run the deploy command with your Team ID:
305−```
331+```bash
306332result-ios/bin/deploy [TEAM_ID]
307333# or in debug mode via lldb:
308334result-ios/bin/deploy [TEAM_ID] -d
@@ -312,7 +338,7 @@ result-ios/bin/deploy [TEAM_ID] -d
3123381. Go to [developer portal - distribution profiles](https://developer.apple.com/account/ios/profile/production).
313339Create and download a distribution profile.
3143401. Run the package script with your TEAM ID and your distribution profile to create a `.ipa`:
315−```
341+```bash
316342result-ios/bin/package [TEAM_ID] /path/to/output/.ipa /path/to/profile/file
317343```
318344
all-builds.nix+2−4
@@ -3,10 +3,7 @@
33 iosSdkVersion = "10.2";
44 }
55, local-self ? import ./. self-args
6−, supportedSystems ? [
7− "x86_64-linux"
8− "x86_64-darwin"
9− ]
6+, supportedSystems ? [ builtins.currentSystem ]
107}:
118
129let
@@ -68,6 +65,7 @@ let
6865 iosSkeleton = (import ./skeleton { inherit obelisk; }).ios.frontend;
6966 nameSuffix = if profiling then "profiled" else "unprofiled";
7067 packages = {
68+ skeletonProfiledObRun = skeleton.__unstable__.profiledObRun;
7169 inherit
7270 command
7371 serverSkeletonShell
default.nix+65−21
@@ -5,10 +5,18 @@
55, reflex-platform-func ? import ./dep/reflex-platform
66}:
77let
8− cleanSource = builtins.filterSource (name: _: let baseName = builtins.baseNameOf name; in !(
9− builtins.match "^\\.ghc\\.environment.*" baseName != null ||
10− baseName == "cabal.project.local"
11− ));
8+ reflex-platform = getReflexPlatform { inherit system; };
9+ inherit (reflex-platform) hackGet nixpkgs;
10+ pkgs = nixpkgs;
11+
12+ inherit (import dep/gitignore.nix { inherit (nixpkgs) lib; }) gitignoreSource;
13+
14+ cleanSource = src:
15+ # WARNING: The order of application here seems to matter a great deal to
16+ # how quickly `ghcid` is able to reload changes. As a rule of thumb,
17+ # always apply `gitignoreSource` first.
18+ # See https://github.com/obsidiansystems/obelisk/pull/666 and related.
19+ pkgs.lib.cleanSource (gitignoreSource src);
1220
1321 commandRuntimeDeps = pkgs: with pkgs; [
1422 coreutils
@@ -17,10 +25,8 @@ let
1725 openssh
1826 ];
1927
20− getReflexPlatform = sys: reflex-platform-func {
21− inherit iosSdkVersion config;
22− system = sys;
23− enableLibraryProfiling = profiling;
28+ getReflexPlatform = { system, enableLibraryProfiling ? profiling }: reflex-platform-func {
29+ inherit iosSdkVersion config system enableLibraryProfiling;
2430
2531 nixpkgsOverlays = [
2632 (self: super: {
@@ -39,6 +45,8 @@ let
3945 hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};
4046
4147 ghcid = self.callCabal2nix "ghcid" (hackGet ./dep/ghcid) {};
48+ # Exports more internals
49+ snap-core = haskellLib.dontCheck (self.callCabal2nix "snap-core" (hackGet ./dep/snap-core) {});
4250 })
4351
4452 pkgs.obeliskExecutableConfig.haskellOverlay
@@ -58,6 +66,7 @@ let
5866 obelisk-cliapp = self.callCabal2nix "obelisk-cliapp" (cleanSource ./lib/cliapp) {};
5967 obelisk-command = haskellLib.overrideCabal (self.callCabal2nix "obelisk-command" (cleanSource ./lib/command) {}) {
6068 librarySystemDepends = [
69+ pkgs.jre
6170 pkgs.nix
6271 (haskellLib.justStaticExecutables self.ghcid)
6372 ];
@@ -102,10 +111,6 @@ let
102111 ];
103112 };
104113
105− reflex-platform = getReflexPlatform system;
106− inherit (reflex-platform) hackGet nixpkgs;
107− pkgs = nixpkgs;
108−
109114 # The haskell environment used to build Obelisk itself, e.g. the 'ob' command
110115 ghcObelisk = reflex-platform.ghc;
111116
@@ -167,18 +172,28 @@ in rec {
167172 '';
168173
169174 serverModules = {
170− mkBaseEc2 = { hostName, routeHost, enableHttps, adminEmail, ... }: {...}: {
175+ mkBaseEc2 = { nixosPkgs, ... }: {...}: {
171176 imports = [
172− (pkgs.path + /nixos/modules/virtualisation/amazon-image.nix)
177+ (nixosPkgs.path + /nixos/modules/virtualisation/amazon-image.nix)
173178 ];
179+ ec2.hvm = true;
180+ };
181+
182+ mkDefaultNetworking = { adminEmail, enableHttps, hostName, routeHost, ... }: {...}: {
174183 networking = {
175184 inherit hostName;
176185 firewall.allowedTCPPorts = if enableHttps then [ 80 443 ] else [ 80 ];
177186 };
187+
188+ # `amazon-image.nix` already sets these but if the user provides their own module then
189+ # forgetting these can cause them to lose access to the server!
190+ # https://github.com/NixOS/nixpkgs/blob/fab05f17d15e4e125def4fd4e708d205b41d8d74/nixos/modules/virtualisation/amazon-image.nix#L133-L136
191+ services.openssh.enable = true;
192+ services.openssh.permitRootLogin = "prohibit-password";
193+
178194 security.acme.certs = if enableHttps then {
179195 "${routeHost}".email = adminEmail;
180196 } else {};
181− ec2.hvm = true;
182197 };
183198
184199 mkObeliskApp =
@@ -245,14 +260,15 @@ in rec {
245260 echo ${version} > $out/version
246261 '';
247262
248− server = { exe, hostName, adminEmail, routeHost, enableHttps, version }@args:
263+ server = { exe, hostName, adminEmail, routeHost, enableHttps, version, module ? serverModules.mkBaseEc2 }@args:
249264 let
250265 nixos = import (pkgs.path + /nixos);
251266 in nixos {
252267 system = "x86_64-linux";
253268 configuration = {
254269 imports = [
255− (serverModules.mkBaseEc2 args)
270+ (module { inherit exe hostName adminEmail routeHost enableHttps version; nixosPkgs = pkgs; })
271+ (serverModules.mkDefaultNetworking args)
256272 (serverModules.mkObeliskApp args)
257273 ];
258274 };
@@ -261,7 +277,7 @@ in rec {
261277 # An Obelisk project is a reflex-platform project with a predefined layout and role for each component
262278 project = base': projectDefinition:
263279 let
264− projectOut = sys: let reflexPlatformProject = (getReflexPlatform sys).project; in reflexPlatformProject (args@{ nixpkgs, ... }:
280+ projectOut = { system, enableLibraryProfiling ? profiling }: let reflexPlatformProject = (getReflexPlatform { inherit system enableLibraryProfiling; }).project; in reflexPlatformProject (args@{ nixpkgs, ... }:
265281 let
266282 inherit (lib.strings) hasPrefix;
267283 mkProject =
@@ -366,20 +382,48 @@ in rec {
366382 });
367383 in allConfig;
368384 in (mkProject (projectDefinition args)).projectConfig);
369− mainProjectOut = projectOut system;
385+ mainProjectOut = projectOut { inherit system; };
370386 serverOn = projectInst: version: serverExe
371387 projectInst.ghc.backend
372388 mainProjectOut.ghcjs.frontend
373389 projectInst.passthru.staticFiles
374390 projectInst.passthru.__closureCompilerOptimizationLevel
375391 version;
376− linuxExe = serverOn (projectOut "x86_64-linux");
392+ linuxExe = serverOn (projectOut { system = "x86_64-linux"; });
377393 dummyVersion = "Version number is only available for deployments";
378394 in mainProjectOut // {
395+ __unstable__.profiledObRun = let
396+ profiled = projectOut { inherit system; enableLibraryProfiling = true; };
397+ exeSource = builtins.toFile "ob-run.hs" ''
398+ module Main where
399+
400+ import Control.Exception
401+ import Reflex.Profiled
402+ import System.Environment
403+
404+ import qualified Obelisk.Run
405+ import qualified Frontend
406+ import qualified Backend
407+
408+ main :: IO ()
409+ main = do
410+ args <- getArgs
411+ let port = read $ args !! 0
412+ assets = args !! 1
413+ profileFile = (args !! 2) <> ".rprof"
414+ Obelisk.Run.run port (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend `finally` writeProfilingData profileFile
415+ '';
416+ in nixpkgs.runCommand "ob-run" {
417+ buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];
418+ } ''
419+ mkdir -p $out/bin/
420+ ghc -x hs -prof -fno-prof-auto -threaded ${exeSource} -o $out/bin/ob-run
421+ '';
422+
379423 linuxExeConfigurable = linuxExe;
380424 linuxExe = linuxExe dummyVersion;
381425 exe = serverOn mainProjectOut dummyVersion;
382− server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:
426+ server = args@{ hostName, adminEmail, routeHost, enableHttps, version, module ? serverModules.mkBaseEc2 }:
383427 server (args // { exe = linuxExe version; });
384428 obelisk = import (base' + "/.obelisk/impl") {};
385429 };
dep/gitignore.nix/default.nixnew file+8
@@ -0,0 +1,8 @@
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+in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))
dep/gitignore.nix/github.jsonnew file+8
@@ -0,0 +1,8 @@
1+{
2+ "owner": "hercules-ci",
3+ "repo": "gitignore.nix",
4+ "branch": "master",
5+ "private": false,
6+ "rev": "7415c4feb127845553943a3856cbc5cb967ee5e0",
7+ "sha256": "1zd1ylgkndbb5szji32ivfhwh04mr1sbgrnvbrqpmfb67g2g3r9i"
8+}
dep/reflex-platform/github.json+3−3
@@ -1,8 +1,8 @@
11{
22 "owner": "reflex-frp",
33 "repo": "reflex-platform",
4− "branch": "master",
4+ "branch": "develop",
55 "private": false,
6− "rev": "5429278830e1555a577f2550e045ce7f7164aa65",
7− "sha256": "1lp86cgccmim573rarsjny5vh0ygkfp5afq7006li0k9w2sw2d4c"
6+ "rev": "156ebb7c391ec909d19e794e591f107462862543",
7+ "sha256": "0rvbaimcvcica80538i6vxckv8si1gbd1ynvgxv7zr5jd1gk6vi5"
88}
dep/snap-core/default.nixnew file+8
@@ -0,0 +1,8 @@
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+in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))
dep/snap-core/github.jsonnew file+8
@@ -0,0 +1,8 @@
1+{
2+ "owner": "obsidiansystems",
3+ "repo": "snap-core",
4+ "branch": "ts-expose-fileserve-internals",
5+ "private": false,
6+ "rev": "e015fc484e38dd9389c58b277b1884395e553bdf",
7+ "sha256": "1793x1h4lw9vnrii5akhfxx1x9yrgxf3052jf6bs8f1mhaic6mxx"
8+}
lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+14−4
@@ -12,12 +12,13 @@ import Obelisk.Asset.Accept (Encoding (..), acceptEncodingBody, chooseEncoding,
1212import Obelisk.Snap.Extras
1313
1414import Snap
15− (MonadSnap, getHeader, getsRequest, modifyResponse, pass, redirect, sendFile, setContentLength, setContentType, setHeader, setResponseCode)
15+ (MonadSnap, getHeader, getRequest, getsRequest, modifyResponse, pass, redirect, sendFile, setContentLength, setContentType, setHeader, setResponseCode)
1616import Snap.Util.FileServe (defaultMimeTypes, fileType, getSafePath, serveFile)
17+import Snap.Internal.Util.FileServe (checkRangeReq)
1718
1819import Control.Applicative ((<|>))
1920import Control.Exception (handleJust, try, throwIO)
20−import Control.Monad (forM, liftM)
21+import Control.Monad (forM, liftM, unless)
2122import Control.Monad.IO.Class (liftIO)
2223import Control.Monad.Fail (MonadFail)
2324import Data.Attoparsec.ByteString (parseOnly, endOfInput)
@@ -94,8 +95,17 @@ serveAsset' doRedirect base fallback p = do
9495 let finalFilename = base </> p </> "encodings" </> T.unpack (decodeUtf8 e)
9596 stat <- liftIO $ getFileStatus finalFilename
9697 modifyResponse $ setHeader "Last-Modified" "Thu, 1 Jan 1970 00:00:00 GMT"
97− modifyResponse $ setResponseCode 200 . setContentLength (fromIntegral $ fileSize stat) . setContentType (fileType defaultMimeTypes p)
98− sendFile finalFilename
98+ . setHeader "Accept-Ranges" "bytes"
99+ . setContentType (fileType defaultMimeTypes p)
100+ let size = fromIntegral $ fileSize stat
101+ req <- getRequest
102+ -- Despite the name, this function actually does all of the work for
103+ -- responding to range requests. We only need to handle *none* range
104+ -- requests ourselves.
105+ wasRange <- checkRangeReq req finalFilename size
106+ unless wasRange $ do
107+ modifyResponse $ setResponseCode 200 . setContentLength size
108+ sendFile finalFilename
99109 Just _ -> cachePermanently >> modifyResponse (setResponseCode 304)
100110 Right "redirect" -> do
101111 mtarget <- liftIO $ getAssetTarget $ base </> p
lib/backend/src/Obelisk/Backend.hs+87−34
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveFunctor #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE GADTs #-}
@@ -10,6 +11,18 @@
1011module Obelisk.Backend
1112 ( Backend (..)
1213 , StaticAssets (..)
14+ -- * Running a backend
15+ , runBackend
16+ , runBackendWith
17+ -- * Configuration of backend
18+ , GhcjsWidgets(..)
19+ , defaultGhcjsWidgets
20+ -- * all.js script loading functions
21+ , deferredGhcjsScript
22+ , delayedGhcjsScript
23+ -- * all.js preload functions
24+ , preloadGhcjs
25+ , renderAllJsPath
1326 -- * Re-exports
1427 , Default (def)
1528 , getPageName
@@ -18,15 +31,10 @@ module Obelisk.Backend
1831 , runSnapWithConfig
1932 , serveDefaultObeliskApp
2033 , prettifyOutput
21− , runBackend
22− , runBackendWith
2334 , staticRenderContentType
24− , mkRouteToUrl
2535 , getPublicConfigs
2636 ) where
2737
28−import Prelude hiding (id, (.))
29−import Control.Category
3038import Control.Monad
3139import Control.Monad.Except
3240import Control.Monad.Fail (MonadFail)
@@ -63,19 +71,36 @@ data GhcjsApp route = GhcjsApp
6371 , _ghcjsApp_value :: !(Frontend route)
6472 }
6573
74+-- | Widgets used to load all.js on the frontend
75+data GhcjsWidgets a = GhcjsWidgets
76+ { _ghcjsWidgets_preload :: a
77+ -- ^ A preload widget, placed in the document head
78+ , _ghcjsWidgets_script :: a
79+ -- ^ A script widget, placed in the document body
80+ } deriving Functor
81+
82+
83+-- | Given the URL of all.js, return the widgets which are responsible for
84+-- loading the script. Defaults to 'preloadGhcjs' and 'deferredGhcjsScript'.
85+defaultGhcjsWidgets :: GhcjsWidgets (Text -> FrontendWidgetT r ())
86+defaultGhcjsWidgets = GhcjsWidgets
87+ { _ghcjsWidgets_preload = preloadGhcjs
88+ , _ghcjsWidgets_script = deferredGhcjsScript
89+ }
90+
6691-- | Serve a frontend, which must be the same frontend that Obelisk has built and placed in the default location
6792--TODO: The frontend should be provided together with the asset paths so that this isn't so easily breakable; that will probably make this function obsolete
6893serveDefaultObeliskApp
6994 :: (MonadSnap m, HasCookies m, MonadFail m)
70− => (R appRoute
71− -> Text)
72− -> ([Text]
73− -> m ())
95+ => (R appRoute -> Text)
96+ -> GhcjsWidgets (FrontendWidgetT (R appRoute) ())
97+ -> ([Text] -> m ())
7498 -> Frontend (R appRoute)
7599 -> Map Text ByteString
76100 -> R (ObeliskRoute appRoute)
77101 -> m ()
78−serveDefaultObeliskApp urlEnc serveStaticAsset frontend = serveObeliskApp urlEnc serveStaticAsset frontendApp
102+serveDefaultObeliskApp urlEnc ghcjsWidgets serveStaticAsset frontend =
103+ serveObeliskApp urlEnc ghcjsWidgets serveStaticAsset frontendApp
79104 where frontendApp = GhcjsApp
80105 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets
81106 , _ghcjsApp_value = frontend
@@ -125,19 +150,24 @@ getRouteWith e = do
125150 pageName <- getPageName
126151 return $ tryDecode e pageName
127152
153+renderAllJsPath :: Encoder Identity Identity (R (FullRoute a b)) PageName -> Text
154+renderAllJsPath validFullEncoder =
155+ renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_Resource ResourceRoute_Ghcjs) :/ ["all.js"]
156+
128157serveObeliskApp
129158 :: (MonadSnap m, HasCookies m, MonadFail m)
130159 => (R appRoute -> Text)
160+ -> GhcjsWidgets (FrontendWidgetT (R appRoute) ())
131161 -> ([Text] -> m ())
132162 -> GhcjsApp (R appRoute)
133163 -> Map Text ByteString
134164 -> R (ObeliskRoute appRoute)
135165 -> m ()
136−serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case
137− ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest
166+serveObeliskApp urlEnc ghcjsWidgets serveStaticAsset frontendApp config = \case
167+ ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc ghcjsWidgets frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest
138168 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of
139169 ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments
140− ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments
170+ ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc ghcjsWidgets frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments
141171 ResourceRoute_JSaddleWarp :=> Identity _ -> do
142172 let msg = "Error: Obelisk.Backend received jsaddle request"
143173 liftIO $ putStrLn $ T.unpack msg
@@ -164,63 +194,86 @@ staticRenderContentType = "text/html; charset=utf-8"
164194serveGhcjsApp
165195 :: (MonadSnap m, HasCookies m, MonadFail m)
166196 => (R appRouteComponent -> Text)
197+ -> GhcjsWidgets (FrontendWidgetT (R appRouteComponent) ())
167198 -> GhcjsApp (R appRouteComponent)
168199 -> Map Text ByteString
169200 -> R (GhcjsAppRoute appRouteComponent)
170201 -> m ()
171−serveGhcjsApp urlEnc app config = \case
202+serveGhcjsApp urlEnc ghcjsWidgets app config = \case
172203 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do
173204 modifyResponse $ setContentType staticRenderContentType
174205 modifyResponse $ setHeader "Cache-Control" "no-store private"
175− writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app
206+ writeBS <=< renderGhcjsFrontend urlEnc ghcjsWidgets (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app
176207 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
177208
178209-- | Run an obelisk backend
179210runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
180−runBackend = runBackendWith runSnapWithCommandLineArgs defaultStaticAssets
211+runBackend = runBackendWith runSnapWithCommandLineArgs defaultStaticAssets defaultGhcjsWidgets
181212
182−-- | Run an obelisk backend using the given function to run the snap monad and
183−-- custom static assets
184213runBackendWith
185214 :: (Snap () -> IO ())
186215 -- ^ Run the snap server
187216 -> StaticAssets
188217 -- ^ Use these assets
189− -> Backend fullRoute frontendRoute
190− -- ^ Backend to run
218+ -> GhcjsWidgets (Text -> FrontendWidgetT (R frontendRoute) ())
219+ -- ^ Given the URL of all.js, return the widgets which are responsible for
220+ -- loading the script.
221+ -> Backend backendRoute frontendRoute
191222 -> Frontend (R frontendRoute)
192− -- ^ Corresponding frontend (for static rendering)
193223 -> IO ()
194−runBackendWith runSnap staticAssets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
224+runBackendWith runSnap staticAssets ghcjsWidgets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
195225 Left e -> fail $ "backend error:\n" <> T.unpack e
196226 Right validFullEncoder -> do
197227 publicConfigs <- getPublicConfigs
198− _backend_run backend $ \serveRoute -> do
199− runSnap $ do
228+ _backend_run backend $ \serveRoute ->
229+ runSnap $
200230 getRouteWith validFullEncoder >>= \case
201231 Identity r -> case r of
202232 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
203233 FullRoute_Frontend obeliskRoute :/ a ->
204− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets staticAssets) frontend publicConfigs $
234+ serveDefaultObeliskApp routeToUrl (($ allJsUrl) <$> ghcjsWidgets) (serveStaticAssets staticAssets) frontend publicConfigs $
205235 obeliskRoute :/ a
206−
207−mkRouteToUrl :: Encoder Identity parse (R (FullRoute br fr)) PageName -> R fr -> Text
208−mkRouteToUrl validFullEncoder =
209− let pageNameEncoder' :: Encoder Identity (Either Text) PageName PathQuery = pageNameEncoder
210− in \(k :/ v) -> T.pack . uncurry (<>) . encode pageNameEncoder' . encode validFullEncoder $ (FullRoute_Frontend $ ObeliskRoute_App k) :/ v
236+ where
237+ routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v
238+ allJsUrl = renderAllJsPath validFullEncoder
211239
212240renderGhcjsFrontend
213241 :: (MonadSnap m, HasCookies m)
214242 => (route -> Text)
243+ -> GhcjsWidgets (FrontendWidgetT route ())
215244 -> route
216245 -> Map Text ByteString
217246 -> Frontend route
218247 -> m ByteString
219−renderGhcjsFrontend urlEnc route configs f = do
220− let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "ghcjs/all.js") blank
221− ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank
248+renderGhcjsFrontend urlEnc ghcjsWidgets route configs f = do
222249 cookies <- askCookies
223− renderFrontendHtml configs cookies urlEnc route f ghcjsPreload ghcjsScript
250+ renderFrontendHtml configs cookies urlEnc route f (_ghcjsWidgets_preload ghcjsWidgets) (_ghcjsWidgets_script ghcjsWidgets)
251+
252+-- | Preload all.js in a link tag.
253+-- This is the default preload method.
254+preloadGhcjs :: Text -> FrontendWidgetT r ()
255+preloadGhcjs allJsUrl = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank
256+
257+-- | Load the script from the given URL in a deferred script tag.
258+-- This is the default method.
259+deferredGhcjsScript :: Text -> FrontendWidgetT r ()
260+deferredGhcjsScript allJsUrl = elAttr "script" ("type" =: "text/javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
261+
262+-- | An all.js script which is loaded after waiting for some time to pass. This
263+-- is useful to ensure any CSS animations on the page can play smoothly before
264+-- blocking the UI thread by running all.js.
265+delayedGhcjsScript
266+ :: Int -- ^ The number of milliseconds to delay loading by
267+ -> Text -- ^ URL to GHCJS app JavaScript
268+ -> FrontendWidgetT r ()
269+delayedGhcjsScript n allJsUrl = elAttr "script" ("type" =: "text/javascript") $ text $ T.unlines
270+ [ "setTimeout(function() {"
271+ , " var all_js_script = document.createElement('script');"
272+ , " all_js_script.type = 'text/javascript';"
273+ , " all_js_script.src = '" <> allJsUrl <> "';"
274+ , " document.body.appendChild(all_js_script);"
275+ , "}, " <> T.pack (show n) <> ");"
276+ ]
224277
225278instance HasCookies Snap where
226279 askCookies = map (\c -> (cookieName c, cookieValue c)) <$> getsRequest rqCookies
lib/cliapp/src/Obelisk/CliApp.hs+1
@@ -51,6 +51,7 @@ module Obelisk.CliApp
5151 , setDelegateCtlc
5252 , setEnvOverride
5353 , shell
54+ , waitForProcess
5455 ) where
5556
5657import Control.Monad.Log (Severity (..))
lib/cliapp/src/Obelisk/CliApp/Process.hs+8−3
@@ -28,6 +28,7 @@ module Obelisk.CliApp.Process
2828 , setDelegateCtlc
2929 , setEnvOverride
3030 , shell
31+ , waitForProcess
3132 ) where
3233
3334import Control.Monad ((<=<), join, void)
@@ -51,7 +52,7 @@ import System.IO (Handle)
5152import System.IO.Streams (InputStream, handleToInputStream)
5253import qualified System.IO.Streams as Streams
5354import System.IO.Streams.Concurrent (concurrentMerge)
54−import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out, waitForProcess)
55+import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out)
5556import qualified System.Process as Process
5657import qualified Data.Aeson as Aeson
5758
@@ -143,7 +144,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do
143144 outText <- liftIO $ T.decodeUtf8With lenientDecode <$> BS.hGetContents out
144145 putLogRaw sev_out outText
145146
146− liftIO (waitForProcess p) >>= \case
147+ waitForProcess p >>= \case
147148 ExitSuccess -> pure outText
148149 ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code
149150
@@ -218,7 +219,7 @@ withProcess process f = do -- TODO: Use bracket.
218219
219220 f out err -- Pass the handles to the passed function
220221
221− liftIO (waitForProcess p) >>= \case
222+ waitForProcess p >>= \case
222223 ExitSuccess -> return (out, err)
223224 ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code
224225
@@ -235,6 +236,10 @@ streamToLog stream = fix $ \loop -> do
235236 Nothing -> return ()
236237 Just (sev, line) -> putLogRaw sev (T.decodeUtf8With lenientDecode line) >> loop
237238
239+-- | Wrapper around `System.Process.waitForProcess`
240+waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode
241+waitForProcess = liftIO . Process.waitForProcess
242+
238243-- | Pretty print a 'CmdSpec'
239244reconstructCommand :: Process.CmdSpec -> Text
240245reconstructCommand p = case p of
lib/command/obelisk-command.cabal+1−2
@@ -1,5 +1,5 @@
11name: obelisk-command
2−version: 0.4
2+version: 0.6
33cabal-version: >= 1.8
44build-type: Simple
55
@@ -20,7 +20,6 @@ library
2020 , either
2121 , errors
2222 , exceptions
23− , extra
2423 , filepath
2524 , git
2625 , github
lib/command/src/Obelisk/Command.hs+25−3
@@ -87,6 +87,7 @@ data ObCommand
8787 = ObCommand_Init InitSource Bool
8888 | ObCommand_Deploy DeployCommand
8989 | ObCommand_Run
90+ | ObCommand_Profile String [String]
9091 | ObCommand_Thunk ThunkCommand
9192 | ObCommand_Repl
9293 | ObCommand_Watch
@@ -108,6 +109,7 @@ obCommand cfg = hsubparser
108109 [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
109110 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
110111 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
112+ , command "profile" $ info (uncurry ObCommand_Profile <$> profileCommand) $ progDesc "Run current project with profiling enabled"
111113 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
112114 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
113115 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
@@ -133,7 +135,7 @@ deployCommand cfg = hsubparser $ mconcat
133135 where
134136 platformP = hsubparser $ mconcat
135137 [ command "android" $ info (pure (Android, [])) mempty
136− , command "ios" $ info ((,) <$> pure IOS <*> (fmap pure $ strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty
138+ , command "ios" $ info ((,) <$> pure IOS <*> fmap pure (strArgument (metavar "TEAMID" <> help "Your Team ID - found in the Apple developer portal"))) mempty
137139 ]
138140
139141 remoteBuilderParser :: Parser (Maybe RemoteBuilder)
@@ -155,8 +157,8 @@ deployCommand cfg = hsubparser $ mconcat
155157
156158deployInitOpts :: Parser DeployInitOpts
157159deployInitOpts = DeployInitOpts
158− <$> strArgument (action "directory" <> metavar "DEPLOYDIR" <> help "Path to a directory that it will create")
159− <*> strOption (long "ssh-key" <> action "file" <> metavar "SSHKEY" <> help "Path to an ssh key that it will symlink to")
160+ <$> strArgument (action "directory" <> metavar "DEPLOYDIR" <> help "Path to a directory where the deployment repository will be initialized")
161+ <*> strOption (long "ssh-key" <> action "file" <> metavar "SSHKEY" <> help "Path to an SSH key that will be *copied* to the deployment repository")
160162 <*> some (strOption (long "hostname" <> metavar "HOSTNAME" <> help "hostname of the deployment target"))
161163 <*> strOption (long "route" <> metavar "PUBLICROUTE" <> help "Publicly accessible URL of your app")
162164 <*> strOption (long "admin-email" <> metavar "ADMINEMAIL" <> help "Email address where administrative alerts will be sent")
@@ -183,6 +185,25 @@ data DeployInitOpts = DeployInitOpts
183185 }
184186 deriving Show
185187
188+profileCommand :: Parser (String, [String])
189+profileCommand = (,)
190+ <$> strOption
191+ ( long "output"
192+ <> short 'o'
193+ <> help "Base output to use for profiling output. Suffixes are added to this based on the profiling type. Defaults to a timestamped path in the profile/ directory in the project's root."
194+ <> metavar "PATH"
195+ <> value "profile/%Y-%m-%dT%H:%M:%S"
196+ <> showDefault
197+ )
198+ <*> (words <$> strOption
199+ ( long "rts-flags"
200+ <> help "RTS Flags to pass to the executable."
201+ <> value "-p -hc"
202+ <> metavar "FLAGS"
203+ <> showDefault
204+ ))
205+
206+
186207--TODO: Result should provide normalised path and also original user input for error reporting.
187208thunkDirectoryParser :: Parser FilePath
188209thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgument $ mconcat
@@ -366,6 +387,7 @@ ob = \case
366387 DeployCommand_Update -> deployUpdate "."
367388 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs
368389 ObCommand_Run -> run
390+ ObCommand_Profile basePath rtsFlags -> profile basePath rtsFlags
369391 ObCommand_Thunk tc -> case tc of
370392 ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)
371393 ThunkCommand_Unpack thunks -> for_ thunks unpackThunk
lib/command/src/Obelisk/Command/Deploy.hs+61−60
@@ -8,22 +8,17 @@ module Obelisk.Command.Deploy where
88
99import Control.Lens
1010import Control.Monad
11−import Control.Monad.Catch (Exception (displayException), MonadThrow, throwM, try, bracket_)
11+import Control.Monad.Catch (Exception (displayException), MonadThrow, bracket, throwM, try)
1212import Control.Monad.IO.Class (liftIO)
1313import Data.Aeson (FromJSON, ToJSON, encode, eitherDecode)
1414import Data.Bits
1515import qualified Data.ByteString.Lazy as BSL
1616import Data.Default
17−import qualified Data.HashMap.Strict as HM
1817import qualified Data.Map as Map
19−import Data.Text (Text)
2018import qualified Data.Set as Set
2119import qualified Data.Text as T
2220import qualified Data.Text.IO as T
2321import GHC.Generics
24−import Nix.Pretty
25−import Nix.String (principledMakeNixStringWithoutContext)
26−import Nix.Value
2722import System.Directory
2823import System.FilePath
2924import System.IO
@@ -53,6 +48,7 @@ deployInit
5348 -> Bool -- ^ enable https
5449 -> m ()
5550deployInit thunkPtr deployDir sshKeyPath hostnames route adminEmail enableHttps = do
51+ liftIO $ createDirectoryIfMissing True deployDir
5652 localKey <- withSpinner ("Preparing " <> T.pack deployDir) $ do
5753 localKey <- liftIO (doesFileExist sshKeyPath) >>= \case
5854 False -> failWith $ T.pack $ "ob deploy init: file does not exist: " <> sshKeyPath
@@ -79,22 +75,30 @@ deployInit thunkPtr deployDir sshKeyPath hostnames route adminEmail enableHttps
7975 , deployDir </> "config" </> "common"
8076 , deployDir </> "config" </> "frontend"
8177 ]
78+
79+ let srcDir = deployDir </> "src"
80+ withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ liftIO $ do
81+ createThunk srcDir thunkPtr
82+ setupObeliskImpl deployDir
83+
8284 withSpinner "Writing deployment configuration" $ do
8385 writeDeployConfig deployDir "backend_hosts" $ unlines hostnames
8486 writeDeployConfig deployDir "enable_https" $ show enableHttps
8587 writeDeployConfig deployDir "admin_email" adminEmail
8688 writeDeployConfig deployDir ("config" </> "common" </> "route") route
87− withSpinner "Creating source thunk (./src)" $ liftIO $ do
88− createThunk (deployDir </> "src") thunkPtr
89− setupObeliskImpl deployDir
89+ writeDeployConfig deployDir "module.nix" $
90+ "(import " <> toNixPath (makeRelative deployDir srcDir) <> " {}).obelisk.serverModules.mkBaseEc2"
91+
9092 withSpinner ("Initializing git repository (" <> T.pack deployDir <> ")") $
9193 initGit deployDir
9294
9395setupObeliskImpl :: FilePath -> IO ()
9496setupObeliskImpl deployDir = do
95− let implDir = toImplDir deployDir
97+ let
98+ implDir = toImplDir deployDir
99+ goBackUp = foldr (</>) "" $ (".." <$) $ splitPath $ makeRelative deployDir implDir
96100 createDirectoryIfMissing True implDir
97− writeFile (implDir </> "default.nix") "(import ../../src {}).obelisk"
101+ writeFile (implDir </> "default.nix") $ "(import " <> toNixPath (goBackUp </> "src") <> " {}).obelisk"
98102
99103deployPush :: MonadObelisk m => FilePath -> m [String] -> m ()
100104deployPush deployPath getNixBuilders = do
@@ -113,6 +117,8 @@ deployPush deployPath getNixBuilders = do
113117 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
114118 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
115119 builders <- getNixBuilders
120+ let moduleFile = deployPath </> "module.nix"
121+ moduleFileExists <- liftIO $ doesFileExist moduleFile
116122 buildOutputByHost <- ifor (Map.fromSet (const ()) hosts) $ \host () -> do
117123 --TODO: What does it mean if this returns more or less than 1 line of output?
118124 [result] <- fmap lines $ nixCmd $ NixCmd_Build $ def
@@ -122,13 +128,13 @@ deployPush deployPath getNixBuilders = do
122128 , _target_expr = Nothing
123129 }
124130 & nixBuildConfig_outLink .~ OutLink_None
125− & nixCmdConfig_args .~
131+ & nixCmdConfig_args .~ (
126132 [ strArg "hostName" host
127133 , strArg "adminEmail" adminEmail
128134 , strArg "routeHost" routeHost
129135 , strArg "version" version
130136 , boolArg "enableHttps" enableHttps
131− ]
137+ ] <> [rawArg "module" ("import " <> toNixPath moduleFile) | moduleFileExists ])
132138 & nixCmdConfig_builders .~ builders
133139 pure result
134140 let knownHostsPath = deployPath </> "backend_known_hosts"
@@ -172,20 +178,6 @@ deployPush deployPath getNixBuilders = do
172178deployUpdate :: MonadObelisk m => FilePath -> m ()
173179deployUpdate deployPath = updateThunkToLatest (ThunkUpdateConfig Nothing (ThunkConfig Nothing)) (deployPath </> "src")
174180
175−keytoolToAndroidConfig :: KeytoolConfig -> HM.HashMap Text (NValue t Identity m)
176−keytoolToAndroidConfig conf =
177− let path = nvPath $ _keytoolConfig_keystore conf
178− fromStr = nvStr . principledMakeNixStringWithoutContext . T.pack
179− storepass = fromStr $ _keytoolConfig_storepass conf
180− alias = fromStr $ _keytoolConfig_alias conf
181− keypass = fromStr $ _keytoolConfig_keypass conf
182− in HM.fromList
183− [ ("storeFile", path)
184− , ("storePassword", storepass)
185− , ("keyAlias", alias)
186− , ("keyPassword", keypass)
187− ]
188−
189181data PlatformDeployment = Android | IOS
190182 deriving (Show, Eq)
191183
@@ -200,7 +192,7 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do
200192 configDir = root </> "config"
201193 exists <- liftIO $ doesDirectoryExist srcDir
202194 unless exists $ failWith "ob test should be run inside of a deploy directory"
203− nixBuildTarget <- case platform of
195+ (nixBuildTarget, extraArgs) <- case platform of
204196 Android -> do
205197 let keystorePath = root </> "android_keystore.jks"
206198 keytoolConfPath = root </> "android_keytool_config.json"
@@ -224,43 +216,55 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do
224216 checkKeytoolConfExist <- liftIO $ doesFileExist keytoolConfPath
225217 unless checkKeytoolConfExist $ failWith "Missing android KeytoolConfig"
226218 keytoolConfContents <- liftIO $ BSL.readFile keytoolConfPath
227− liftIO $ print keytoolConfContents
228− releaseKey :: String <- case eitherDecode keytoolConfContents :: Either String KeytoolConfig of
219+ keyArgs <- case eitherDecode keytoolConfContents :: Either String KeytoolConfig of
229220 Left err -> failWith $ T.pack err
230− Right conf -> return $
231− (printNix :: MonadObelisk m => NValue t Identity m -> String) $
232− nvSet (keytoolToAndroidConfig conf) HM.empty
221+ Right conf -> pure
222+ [ "--sign"
223+ , "--store-file", _keytoolConfig_keystore conf
224+ , "--store-password", _keytoolConfig_storepass conf
225+ , "--key-alias", _keytoolConfig_alias conf
226+ , "--key-password", _keytoolConfig_keypass conf
227+ ]
233228 let expr = mconcat
234− [ "with (import ", srcDir, " {});"
235− , "android.frontend.override (drv: { "
236− , "releaseKey = (if builtins.isNull drv.releaseKey then {} else drv.releaseKey) // " <> releaseKey <> "; "
229+ [ "with (import ", toNixPath srcDir, " {});"
230+ , "android.frontend.override (drv: {"
231+ , "isRelease = true;"
232+ , "staticSrc = (passthru.__androidWithConfig ", configDir, ").frontend.staticSrc;"
237233 , "assets = (passthru.__androidWithConfig ", configDir, ").frontend.assets;"
238234 , "})"
239235 ]
240− return $ Target
236+ return (Target
241237 { _target_path = Nothing
242238 , _target_attr = Nothing
243239 , _target_expr = Just expr
244− }
240+ }, keyArgs)
245241 IOS -> do
246242 let expr = mconcat
247− [ "with (import ", srcDir, " {});"
248− , "ios.frontend.override (_: { staticSrc = (passthru.__iosWithConfig ", configDir, ").frontend.staticSrc; })"
243+ [ "with (import ", toNixPath srcDir, " {});"
244+ , "ios.frontend.override (_: { staticSrc = (passthru.__iosWithConfig ", toNixPath configDir, ").frontend.staticSrc; })"
249245 ]
250− return $ Target
246+ return (Target
251247 { _target_path = Nothing
252248 , _target_attr = Nothing
253249 , _target_expr = Just expr
254− }
250+ }, [])
255251 result <- nixCmd $ NixCmd_Build $ def
256252 & nixBuildConfig_outLink .~ OutLink_None
257253 & nixCmdConfig_target .~ nixBuildTarget
258− putLog Notice $ T.pack $ "Your recently built android apk can be found at the following path: " <> show result
259− callProcessAndLogOutput (Notice, Error) $ proc (result </> "bin" </> "deploy") mobileArgs
254+ let mobileArtifact = case platform of
255+ IOS -> "iOS App"
256+ Android -> "Android APK"
257+ putLog Notice $ T.pack $ unwords ["Your recently built", mobileArtifact, "can be found at the following path:", show result]
258+ callProcessAndLogOutput (Notice, Error) $ proc (result </> "bin" </> "deploy") (mobileArgs ++ extraArgs)
260259 where
261− withEcho showEcho f = do
262− prevEcho <- hGetEcho stdin
263− bracket_ (hSetEcho stdin showEcho) (hSetEcho stdin prevEcho) f
260+ withEcho showEcho f = bracket
261+ (do
262+ prevEcho <- hGetEcho stdin
263+ hSetEcho stdin showEcho
264+ pure prevEcho
265+ )
266+ (hSetEcho stdin)
267+ (const f)
264268
265269data KeytoolConfig = KeytoolConfig
266270 { _keytoolConfig_keystore :: FilePath
@@ -273,19 +277,16 @@ instance FromJSON KeytoolConfig
273277instance ToJSON KeytoolConfig
274278
275279createKeystore :: MonadObelisk m => FilePath -> KeytoolConfig -> m ()
276−createKeystore root config = do
277− let expr = "with (import " <> toImplDir root <> ").reflex-platform.nixpkgs; pkgs.mkShell { buildInputs = [ pkgs.jdk ]; }"
278− callProcessAndLogOutput (Notice,Notice) $ setCwd (Just root) $ proc "nix-shell" ["default.nix", "-E" , expr, "--run" , keytoolCmd]
279− where
280− keytoolCmd = processToShellString "keytool"
281− [ "-genkeypair", "-noprompt"
282− , "-keystore", _keytoolConfig_keystore config
283− , "-keyalg", "RSA", "-keysize", "2048"
284− , "-validity", "1000000"
285− , "-storepass", _keytoolConfig_storepass config
286− , "-alias", _keytoolConfig_alias config
287− , "-keypass", _keytoolConfig_keypass config
288− ]
280+createKeystore root config =
281+ callProcessAndLogOutput (Notice, Notice) $ setCwd (Just root) $ proc jreKeyToolPath
282+ [ "-genkeypair", "-noprompt"
283+ , "-keystore", _keytoolConfig_keystore config
284+ , "-keyalg", "RSA", "-keysize", "2048"
285+ , "-validity", "1000000"
286+ , "-storepass", _keytoolConfig_storepass config
287+ , "-alias", _keytoolConfig_alias config
288+ , "-keypass", _keytoolConfig_keypass config
289+ ]
289290
290291-- | Simplified deployment configuration mechanism. At one point we may revisit this.
291292writeDeployConfig :: MonadObelisk m => FilePath -> FilePath -> String -> m ()
lib/command/src/Obelisk/Command/Nix.hs+21−11
@@ -32,6 +32,8 @@ module Obelisk.Command.Nix
3232
3333 , boolArg
3434 , nixCmd
35+ , nixCmdProc
36+ , nixCmdProc'
3537 , rawArg
3638 , runNixShellConfig
3739 , strArg
@@ -188,27 +190,35 @@ runNixShellConfig cfg = mconcat
188190 ["--run", run] | run <- maybeToList $ cfg ^. nixShellConfig_run
189191 ]
190192
191−nixCmd :: MonadObelisk m => NixCmd -> m FilePath
192−nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built " <> desc) $ do
193− output <- readProcessAndLogStderr Debug $ proc (T.unpack cmd) options
194− -- Remove final newline that Nix appends
195− Just (outPath, '\n') <- pure $ T.unsnoc output
196− pure $ T.unpack outPath
193+nixCmdProc :: NixCmd -> ProcessSpec
194+nixCmdProc = fst . nixCmdProc'
195+
196+nixCmdProc' :: NixCmd -> (ProcessSpec, T.Text)
197+nixCmdProc' cmdCfg = (proc (T.unpack cmd) options, cmd)
197198 where
198− (cmd, options, commonCfg) = case cmdCfg of
199+ (cmd, options) = case cmdCfg of
199200 NixCmd_Build cfg' ->
200201 ( "nix-build"
201202 , runNixBuildConfig cfg'
202− , cfg' ^. nixCommonConfig
203203 )
204204 NixCmd_Instantiate cfg' ->
205205 ( "nix-instantiate"
206206 , runNixInstantiateConfig cfg'
207− , cfg' ^. nixCommonConfig
208207 )
208+
209+nixCmd :: MonadObelisk m => NixCmd -> m FilePath
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
214+ pure $ T.unpack outPath
215+ where
216+ (cmdProc, cmd) = nixCmdProc' cmdCfg
217+ commonCfg = case cmdCfg of
218+ NixCmd_Build cfg' -> cfg' ^. nixCommonConfig
219+ NixCmd_Instantiate cfg' -> cfg' ^. nixCommonConfig
209220 path = commonCfg ^. nixCmdConfig_target . target_path
210221 desc = T.pack $ mconcat $ catMaybes
211− [ (" on " <>) <$> path
222+ [ ("on " <>) <$> path
212223 , (\a -> " [" <> a <> "]") <$> (commonCfg ^. nixCmdConfig_target . target_attr)
213224 ]
214−
lib/command/src/Obelisk/Command/Project.hs+26−6
@@ -5,6 +5,7 @@ module Obelisk.Command.Project
55 ( InitSource (..)
66 , findProjectObeliskCommand
77 , findProjectRoot
8+ , findProjectAssets
89 , initProject
910 , nixShellRunConfig
1011 , nixShellRunProc
@@ -41,7 +42,6 @@ import System.IO.Temp
4142import System.IO.Unsafe (unsafePerformIO)
4243import System.Posix (FileStatus, FileMode, CMode (..), UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)
4344import System.Posix.Files
44−import System.Process (waitForProcess)
4545
4646import GitHub.Data.GitData (Branch)
4747import GitHub.Data.Name (Name)
@@ -50,7 +50,7 @@ import Obelisk.App (MonadObelisk)
5050import Obelisk.CliApp
5151import Obelisk.Command.Nix
5252import Obelisk.Command.Thunk
53−import Obelisk.Command.Utils (nixExePath)
53+import Obelisk.Command.Utils (nixExePath, nixBuildExePath)
5454
5555--TODO: Make this module resilient to random exceptions
5656
@@ -186,7 +186,7 @@ findProjectRoot target = do
186186 targetStat <- liftIO $ getFileStatus target
187187 umask <- liftIO getUmask
188188 (result, _) <- liftIO $ runStateT (walkToProjectRoot target targetStat umask myUid) []
189− return result
189+ return $ makeRelative "." <$> result
190190
191191withProjectRoot :: MonadObelisk m => FilePath -> (FilePath -> m a) -> m a
192192withProjectRoot target f = findProjectRoot target >>= \case
@@ -287,7 +287,7 @@ nixShellWithPkgs root isPure chdirToRoot packageNamesAndPaths command = do
287287 [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root
288288 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)
289289 ]
290− void $ liftIO $ waitForProcess ph
290+ void $ waitForProcess ph
291291
292292nixShellWithHoogle :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
293293nixShellWithHoogle root isPure shell' command = do
@@ -298,7 +298,7 @@ nixShellWithHoogle root isPure shell' command = do
298298 \userSettings = super.userSettings // { withHoogle = true; };\
299299 \})).project.shells.${shell}"
300300 & nixShellConfig_common . nixCmdConfig_args .~ [ strArg "shell" shell' ]
301− void $ liftIO $ waitForProcess ph
301+ void $ waitForProcess ph
302302
303303projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()
304304projectShell root isPure shellName command = do
@@ -306,4 +306,24 @@ projectShell root isPure shellName command = do
306306 (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCwd (Just root) $ nixShellRunProc $ defShellConfig
307307 & nixShellConfig_common . nixCmdConfig_target . target_path ?~ "default.nix"
308308 & nixShellConfig_common . nixCmdConfig_target . target_attr ?~ ("shells." <> shellName)
309− void $ liftIO $ waitForProcess ph
309+ void $ waitForProcess ph
310+
311+findProjectAssets :: MonadObelisk m => FilePath -> m Text
312+findProjectAssets root = do
313+ isDerivation <- readProcessAndLogStderr Debug $ setCwd (Just root) $
314+ proc nixExePath
315+ [ "eval"
316+ , "(let a = import ./. {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"
317+ , "--raw"
318+ -- `--raw` is not available with old nix-instantiate. It drops quotation
319+ -- marks and trailing newline, so is very convenient for shelling out.
320+ ]
321+ -- Check whether the impure static files are a derivation (and so must be built)
322+ if isDerivation == "1"
323+ then fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ -- Strip whitespace here because nix-build has no --raw option
324+ proc nixBuildExePath
325+ [ "--no-out-link"
326+ , "-E", "(import ./. {}).passthru.staticFilesImpure"
327+ ]
328+ else readProcessAndLogStderr Debug $ setCwd (Just root) $
329+ proc nixExePath ["eval", "-f", ".", "passthru.staticFilesImpure", "--raw"]
lib/command/src/Obelisk/Command/Run.hs+84−43
@@ -4,18 +4,20 @@
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# LANGUAGE TupleSections #-}
7+{-# LANGUAGE QuasiQuotes #-}
78module Obelisk.Command.Run where
89
910import Control.Arrow ((&&&))
1011import Control.Exception (Exception, bracket)
11−import Control.Monad (filterM, unless)
12+import Control.Lens (ifor, (.~), (&))
13+import Control.Monad (filterM, unless, void)
1214import Control.Monad.Except (runExceptT, throwError)
1315import Control.Monad.IO.Class (liftIO)
1416import Control.Monad.Reader (MonadIO)
1517import Data.Coerce (coerce)
18+import Data.Default (def)
1619import Data.Either
1720import Data.Foldable (for_, toList)
18−import Data.List.Extra (dropPrefix)
1921import qualified Data.List.NonEmpty as NE
2022import Data.Map (Map)
2123import qualified Data.Map as Map
@@ -23,6 +25,8 @@ import Data.Maybe
2325import qualified Data.Set as Set
2426import Data.Text (Text)
2527import qualified Data.Text as T
28+import Data.Time.Clock (getCurrentTime)
29+import Data.Time.Format (formatTime, defaultTimeLocale)
2630import Data.Traversable (for)
2731import Debug.Trace (trace)
2832import Distribution.Compiler (CompilerFlavor(..))
@@ -47,10 +51,23 @@ import qualified System.Info
4751import System.IO.Temp (withSystemTempDirectory)
4852
4953import Obelisk.App (MonadObelisk)
50−import Obelisk.CliApp (Severity (..) , failWith, putLog, proc, readCreateProcessWithExitCode, readProcessAndLogStderr)
51−import Obelisk.Command.Project (obeliskDirName, toObeliskDir, withProjectRoot, nixShellWithPkgs, toNixPath)
54+import Obelisk.CliApp (
55+ Severity (..),
56+ createProcess_,
57+ failWith,
58+ proc,
59+ putLog,
60+ readCreateProcessWithExitCode,
61+ readProcessAndLogStderr,
62+ setCwd,
63+ setDelegateCtlc,
64+ waitForProcess,
65+ withSpinner,
66+ )
67+import Obelisk.Command.Nix
68+import Obelisk.Command.Project (nixShellWithPkgs, toImplDir, withProjectRoot, findProjectAssets)
5269import Obelisk.Command.Thunk (attrCacheFileName)
53−import Obelisk.Command.Utils (findExePath, ghcidExePath, nixBuildExePath, nixExePath)
70+import Obelisk.Command.Utils (findExePath, ghcidExePath)
5471
5572data CabalPackageInfo = CabalPackageInfo
5673 { _cabalPackageInfo_packageFile :: FilePath
@@ -71,32 +88,48 @@ data CabalPackageInfo = CabalPackageInfo
7188preprocessorIdentifier :: String
7289preprocessorIdentifier = "__preprocessor-apply-packages"
7390
74−run :: MonadObelisk m => m ()
91+profile
92+ :: MonadObelisk m
93+ => String
94+ -> [String]
95+ -> m ()
96+profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
97+ putLog Debug "Using profiled build of project."
98+
99+ outPath <- withSpinner "Building profiled executable" $
100+ fmap (T.unpack . T.strip) $ readProcessAndLogStderr Debug $ setCwd (Just root) $ nixCmdProc $
101+ NixCmd_Build $ def
102+ & nixBuildConfig_outLink .~ OutLink_None
103+ & nixCmdConfig_target .~ Target
104+ { _target_path = Just "."
105+ , _target_attr = Just "__unstable__.profiledObRun"
106+ , _target_expr = Nothing
107+ }
108+ assets <- findProjectAssets root
109+ putLog Debug $ "Assets impurely loaded from: " <> assets
110+ time <- liftIO getCurrentTime
111+ let profileBaseName = formatTime defaultTimeLocale profileBasePattern time
112+ liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName
113+ putLog Debug $ "Storing profiled data under base name of " <> T.pack (root </> profileBaseName)
114+ freePort <- getFreePort
115+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $
116+ [ show freePort
117+ , T.unpack assets
118+ , profileBaseName
119+ , "+RTS"
120+ , "-po" <> profileBaseName
121+ ] <> rtsFlags
122+ <> [ "-RTS" ]
123+ void $ waitForProcess ph
124+
125+run
126+ :: MonadObelisk m
127+ => m ()
75128run = withProjectRoot "." $ \root -> do
76129 pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
77130 withGhciScript pkgs root $ \dotGhciPath -> do
78131 freePort <- getFreePort
79− assets <- do
80− let importableRoot = toNixPath root
81− isDerivation <- readProcessAndLogStderr Debug $
82− proc nixExePath
83− [ "eval"
84− , "-f"
85− , root
86− , "(let a = import " <> importableRoot <> " {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"
87− , "--raw"
88− -- `--raw` is not available with old nix-instantiate. It drops quotation
89− -- marks and trailing newline, so is very convenient for shelling out.
90− ]
91− -- Check whether the impure static files are a derivation (and so must be built)
92− if isDerivation == "1"
93− then fmap T.strip $ readProcessAndLogStderr Debug $ -- Strip whitespace here because nix-build has no --raw option
94− proc nixBuildExePath
95− [ "--no-out-link"
96− , "-E", "(import " <> importableRoot <> "{}).passthru.staticFilesImpure"
97− ]
98− else readProcessAndLogStderr Debug $
99− proc nixExePath ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]
132+ assets <- findProjectAssets root
100133 putLog Debug $ "Assets impurely loaded from: " <> assets
101134 runGhcid root True dotGhciPath pkgs $ Just $ unwords
102135 [ "Obelisk.Run.run"
@@ -125,20 +158,19 @@ runWatch = withProjectRoot "." $ \root -> do
125158-- to the Nix @project@ function.
126159getLocalPkgs :: MonadObelisk m => FilePath -> m [FilePath]
127160getLocalPkgs root = do
128− (_exitCode, out, err) <- readCreateProcessWithExitCode $
129− proc findExePath ["-L", root, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
130− putLog Debug $ T.strip $ T.pack err
161+ obeliskPaths <- runFind ["-L", root, "-name", ".obelisk", "-type", "d"]
131162
132− let
133− -- We ignore any path that has ".obelisk" in it, but keep the root ".obelisk" paths
134− packagePaths = filter (not . isIgnored) $ map T.unpack $ T.lines $ T.strip $ T.pack out
135− isIgnored path =
136− obeliskDirName `elem` dropPrefix (splitPath $ toObeliskDir root) pathSegments
137− && attrCacheFileName `notElem` pathSegments
138− where
139− pathSegments = splitPath path
140−
141− pure packagePaths
163+ -- We do not want to find packages that are embedded inside other obelisk projects, unless that
164+ -- obelisk project is our own.
165+ let exclusions = filter (/= root) $ map takeDirectory obeliskPaths
166+ fmap (map (makeRelative ".")) $ runFind $
167+ ["-L", root, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
168+ <> concat [["-not", "-path", p </> "*"] | p <- (toImplDir "*" </> attrCacheFileName) : exclusions]
169+ where
170+ runFind args = do
171+ (_exitCode, out, err) <- readCreateProcessWithExitCode $ proc findExePath args
172+ putLog Debug $ T.strip $ T.pack err
173+ pure $ map T.unpack $ T.lines $ T.strip $ T.pack out
142174
143175data GuessPackageFileError = GuessPackageFileError_Ambiguous [FilePath] | GuessPackageFileError_NotFound
144176 deriving (Eq, Ord, Show)
@@ -248,7 +280,17 @@ parsePackagesOrFail dirs = do
248280 | _cabalPackageInfo_buildable packageInfo -> Right packageInfo
249281 _ -> Left dir
250282
251− packageInfos <- case NE.nonEmpty packageInfos' of
283+ let packagesByName = Map.fromListWith (<>) [(_cabalPackageInfo_packageName p, p NE.:| []) | p <- packageInfos']
284+ unambiguous <- ifor packagesByName $ \packageName ps -> case ps of
285+ p NE.:| [] -> pure p -- No ambiguity here
286+ p NE.:| _ -> do
287+ putLog Warning $ T.pack $
288+ "Packages named '" <> T.unpack packageName <> "' appear in " <> show (length ps) <> " different locations: "
289+ <> intercalate ", " (map _cabalPackageInfo_packageFile $ toList ps)
290+ <> "; Picking " <> _cabalPackageInfo_packageFile p
291+ pure p
292+
293+ packageInfos <- case NE.nonEmpty $ toList unambiguous of
252294 Nothing -> failWith $ T.pack $ "No valid, buildable packages found in " <> intercalate ", " dirs
253295 Just xs -> pure xs
254296
@@ -283,8 +325,7 @@ withGhciScript packageInfos pathBase f = do
283325 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
284326 , "import qualified Obelisk.Run"
285327 , "import qualified Frontend"
286− , "import qualified Backend"
287− ]
328+ , "import qualified Backend" ]
288329 withSystemTempDirectory "ob-ghci" $ \fp -> do
289330 let dotGhciPath = fp </> ".ghci"
290331 liftIO $ writeFile dotGhciPath dotGhci
lib/command/src/Obelisk/Command/Thunk.hs+22−2
@@ -513,9 +513,10 @@ gitHubStandaloneLoaderV4 = T.unlines
513513
514514plainGitStandaloneLoaders :: NonEmpty Text
515515plainGitStandaloneLoaders =
516− plainGitStandaloneLoaderV3 :|
516+ plainGitStandaloneLoaderV4 :|
517517 [ plainGitStandaloneLoaderV1
518518 , plainGitStandaloneLoaderV2
519+ , plainGitStandaloneLoaderV3
519520 ]
520521
521522plainGitStandaloneLoaderV1 :: Text
@@ -536,6 +537,8 @@ plainGitStandaloneLoaderV2 = T.unlines
536537 , "in import (fetchGit (builtins.fromJSON (builtins.readFile ./git.json)))"
537538 ]
538539
540+-- This loader has a bug because @builtins.fetchGit@ is not given a @ref@
541+-- and will fail to find commits without this because it does shallow clones.
539542plainGitStandaloneLoaderV3 :: Text
540543plainGitStandaloneLoaderV3 = T.unlines
541544 [ "# DO NOT HAND-EDIT THIS FILE"
@@ -552,6 +555,23 @@ plainGitStandaloneLoaderV3 = T.unlines
552555 , "in import (fetch (builtins.fromJSON (builtins.readFile ./git.json)))"
553556 ]
554557
558+plainGitStandaloneLoaderV4 :: Text
559+plainGitStandaloneLoaderV4 = T.unlines
560+ [ "# DO NOT HAND-EDIT THIS FILE"
561+ , "let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:"
562+ , " let realUrl = let firstChar = builtins.substring 0 1 url; in"
563+ , " if firstChar == \"/\" then /. + url"
564+ , " else if firstChar == \".\" then ./. + url"
565+ , " else url;"
566+ , " in if !fetchSubmodules && private then builtins.fetchGit {"
567+ , " url = realUrl; inherit rev;"
568+ , " ${if branch == null then null else \"ref\"} = branch;"
569+ , " } else (import <nixpkgs> {}).fetchgit {"
570+ , " url = realUrl; inherit rev sha256;"
571+ , " };"
572+ , "in import (fetch (builtins.fromJSON (builtins.readFile ./git.json)))"
573+ ]
574+
555575thunkFileNames :: [FilePath]
556576thunkFileNames = ["default.nix", "github.json", "git.json"]
557577
@@ -937,7 +957,7 @@ guessGitRepoIsPrivate uri = flip fix urisToTry $ \loop -> \case
937957 urisToTry = nubOrd $
938958 -- Include the original URI if it isn't using SSH because SSH will certainly fail.
939959 [uri | fmap URI.unRText (URI.uriScheme (unGitUri uri)) /= Just "ssh"] <>
940− [changeScheme "https" uri, changeScheme "http" uri, changeScheme "git" uri]
960+ [changeScheme "https" uri, changeScheme "http" uri]
941961 changeScheme scheme (GitUri u) = GitUri $ u
942962 { URI.uriScheme = URI.mkScheme scheme
943963 , URI.uriAuthority = (\x -> x { URI.authUserInfo = Nothing }) <$> URI.uriAuthority u
lib/command/src/Obelisk/Command/Utils.hs+3
@@ -44,6 +44,9 @@ nixExePath = $(staticWhich "nix")
4444nixBuildExePath :: FilePath
4545nixBuildExePath = $(staticWhich "nix-build")
4646
47+jreKeyToolPath :: FilePath
48+jreKeyToolPath = $(staticWhich "keytool")
49+
4750-- Check whether the working directory is clean
4851checkGitCleanStatus :: MonadObelisk m => FilePath -> Bool -> m Bool
4952checkGitCleanStatus repo withIgnored = do
lib/frontend/src/Obelisk/Frontend.hs+6−6
@@ -20,6 +20,7 @@ module Obelisk.Frontend
2020 , renderFrontendHtml
2121 , removeHTMLConfigs
2222 , FrontendMode (..)
23+ , FrontendWidgetT
2324 , module Obelisk.Frontend.Cookie
2425 ) where
2526
@@ -226,18 +227,17 @@ runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = d
226227 then runHydrationWidgetWithHeadAndBody (pure ()) w
227228 else runImmediateWidgetWithHeadAndBody w
228229
230+type FrontendWidgetT r = RoutedT DomTimeline r (SetRouteT DomTimeline r (RouteToUrlT r (ConfigsT (CookiesT (HydratableT (PostBuildT DomTimeline (StaticDomBuilderT DomTimeline (PerformEventT DomTimeline DomHost))))))))
231+
229232renderFrontendHtml
230− :: ( t ~ DomTimeline
231− , MonadIO m
232− , widget ~ RoutedT t r (SetRouteT t r (RouteToUrlT r (ConfigsT (CookiesT (HydratableT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost))))))))
233− )
233+ :: MonadIO m
234234 => Map Text ByteString
235235 -> Cookies
236236 -> (r -> Text)
237237 -> r
238238 -> Frontend r
239− -> widget ()
240− -> widget ()
239+ -> FrontendWidgetT r ()
240+ -> FrontendWidgetT r ()
241241 -> m ByteString
242242renderFrontendHtml configs cookies urlEnc route frontend headExtra bodyExtra = do
243243 --TODO: We should probably have a "NullEventWriterT" or a frozen reflex timeline
lib/route/src/Obelisk/Route/Frontend.hs+80−16
@@ -7,15 +7,11 @@
77{-# LANGUAGE FlexibleContexts #-}
88{-# LANGUAGE FlexibleInstances #-}
99{-# LANGUAGE GADTs #-}
10−{-# LANGUAGE KindSignatures #-}
1110{-# LANGUAGE LambdaCase #-}
12−{-# LANGUAGE MultiParamTypeClasses #-}
1311{-# LANGUAGE OverloadedStrings #-}
1412{-# LANGUAGE PatternSynonyms #-}
1513{-# LANGUAGE RankNTypes #-}
1614{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# LANGUAGE TupleSections #-}
1915{-# LANGUAGE TypeFamilies #-}
2016{-# LANGUAGE TypeOperators #-}
2117{-# LANGUAGE ViewPatterns #-}
@@ -64,7 +60,7 @@ import Prelude hiding ((.), id)
6460import Obelisk.Route
6561
6662import Control.Category (Category (..), (.))
67−import Control.Category.Cartesian
63+import Control.Category.Cartesian ((&&&))
6864import Control.Lens hiding (Bifunctor, bimap, universe, element)
6965import Control.Monad ((<=<))
7066import Control.Monad.Fix
@@ -94,7 +90,9 @@ import Reflex.Dom.Builder.Class
9490import Data.Type.Coercion
9591import Language.Javascript.JSaddle --TODO: Get rid of this - other platforms can also be routed
9692import Reflex.Dom.Core
93+import qualified GHCJS.DOM as DOM
9794import qualified GHCJS.DOM.Types as DOM
95+import qualified GHCJS.DOM.Window as Window
9896import Network.URI
9997import Data.Maybe (fromMaybe)
10098import qualified Data.List as L
@@ -511,59 +509,125 @@ runRouteViewT routeEncoder switchover useHash a = do
511509-- | A link widget that, when clicked, sets the route to the provided route. In non-javascript
512510-- contexts, this widget falls back to using @href@s to control navigation
513511routeLink
514− :: forall t m a route.
512+ :: forall t m a route js.
515513 ( DomBuilder t m
516514 , RouteToUrl route m
517515 , SetRoute t route m
516+ , Prerender js t m
518517 )
519518 => route -- ^ Target route
520519 -> m a -- ^ Child widget
521520 -> m a
522521routeLink r w = do
522+ (e, a) <- routeLinkImpl r w
523+ scrollToTop e
524+ return a
525+
526+-- | Raw implementation of 'routeLink'. Does not scroll to the top of the page on clicks.
527+routeLinkImpl
528+ :: forall t m a route.
529+ ( DomBuilder t m
530+ , RouteToUrl route m
531+ , SetRoute t route m
532+ )
533+ => route -- ^ Target route
534+ -> m a -- ^ Child widget
535+ -> m (Event t (), a)
536+routeLinkImpl r w = do
523537 enc <- askRouteToUrl
524538 let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
525539 & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
526540 & elementConfig_initialAttributes .~ "href" =: enc r
527541 (e, a) <- element "a" cfg w
528542 setRoute $ r <$ domEvent Click e
529− return a
543+ return (domEvent Click e, a)
544+
545+scrollToTop :: forall m t js. (Prerender js t m, Monad m) => Event t () -> m ()
546+scrollToTop e = prerender_ blank $ performEvent_ $ ffor e $ \_ -> liftJSM $ DOM.currentWindow >>= \case
547+ Nothing -> pure ()
548+ Just win -> Window.scrollTo win 0 0
530549
531550-- | Like 'routeLinkDynAttr' but without custom attributes.
532551dynRouteLink
533− :: forall t m a route.
552+ :: forall t m a route js.
534553 ( DomBuilder t m
535554 , PostBuild t m
536− , RouteToUrl (R route) m
537− , SetRoute t (R route) m
555+ , RouteToUrl route m
556+ , SetRoute t route m
557+ , Prerender js t m
538558 )
539− => Dynamic t (R route) -- ^ Target route
540− -> m a -- ^ Child widget of the @a@ element
559+ => Dynamic t route -- ^ Target route
560+ -> m a -- ^ Child widget
541561 -> m a
542−dynRouteLink = routeLinkDynAttr mempty
562+dynRouteLink r w = do
563+ (e, a) <- dynRouteLinkImpl r w
564+ scrollToTop e
565+ return a
566+
567+-- | Raw implementation of 'dynRouteLink'. Does not scroll to the top of the page on clicks.
568+dynRouteLinkImpl
569+ :: forall t m a route.
570+ ( DomBuilder t m
571+ , PostBuild t m
572+ , RouteToUrl route m
573+ , SetRoute t route m
574+ )
575+ => Dynamic t route -- ^ Target route
576+ -> m a -- ^ Child widget
577+ -> m (Event t (), a)
578+dynRouteLinkImpl dr w = do
579+ enc <- askRouteToUrl
580+ er <- dynamicAttributesToModifyAttributes $ ("href" =:) . enc <$> dr
581+ let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
582+ & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
583+ & elementConfig_modifyAttributes .~ er
584+ (e, a) <- element "a" cfg w
585+ let clk = domEvent Click e
586+ setRoute $ tag (current dr) clk
587+ return (clk, a)
543588
544589-- | An @a@-tag link widget that, when clicked, sets the route to current value of the
545590-- provided dynamic route. In non-JavaScript contexts the value of the dynamic post
546591-- build is used so the link still works like 'routeLink'.
547592routeLinkDynAttr
548− :: forall t m a route.
593+ :: forall t m a route js.
549594 ( DomBuilder t m
550595 , PostBuild t m
551596 , RouteToUrl (R route) m
552597 , SetRoute t (R route) m
598+ , Prerender js t m
553599 )
554600 => Dynamic t (Map AttributeName Text) -- ^ Attributes for @a@ element. Note that if @href@ is present it will be ignored
555601 -> Dynamic t (R route) -- ^ Target route
556602 -> m a -- ^ Child widget of the @a@ element
557603 -> m a
558604routeLinkDynAttr dAttr dr w = do
605+ (e, a) <- routeLinkDynAttrImpl dAttr dr w
606+ scrollToTop e
607+ return a
608+
609+-- | Raw implementation of 'routeLinkDynAttr'. Does not scroll to the top of the page on clicks.
610+routeLinkDynAttrImpl
611+ :: forall t m a route.
612+ ( DomBuilder t m
613+ , PostBuild t m
614+ , RouteToUrl (R route) m
615+ , SetRoute t (R route) m
616+ )
617+ => Dynamic t (Map AttributeName Text) -- ^ Attributes for @a@ element. Note that if @href@ is present it will be ignored
618+ -> Dynamic t (R route) -- ^ Target route
619+ -> m a -- ^ Child widget of the @a@ element
620+ -> m (Event t (), a)
621+routeLinkDynAttrImpl dAttr dr w = do
559622 enc <- askRouteToUrl
560623 er <- dynamicAttributesToModifyAttributes $ zipDynWith (<>) (("href" =:) . enc <$> dr) dAttr
561624 let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
562625 & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
563626 & elementConfig_modifyAttributes .~ er
564627 (e, a) <- element "a" cfg w
565− setRoute $ tag (current dr) $ domEvent Click e
566− return a
628+ let clk = domEvent Click e
629+ setRoute $ tag (current dr) clk
630+ return (clk, a)
567631
568632-- On ios due to sandboxing when loading the page from a file adapt the
569633-- path to be based on the hash.
lib/run/src/Obelisk/Run.hs+11−6
@@ -79,7 +79,7 @@ import qualified System.Which
7979run
8080 :: Int -- ^ Port to run the backend
8181 -> ([Text] -> Snap ()) -- ^ Static asset handler
82− -> Backend fullRoute frontendRoute -- ^ Backend
82+ -> Backend backendRoute frontendRoute -- ^ Backend
8383 -> Frontend (R frontendRoute) -- ^ Frontend
8484 -> IO ()
8585run port serveStaticAsset backend frontend = do
@@ -90,14 +90,18 @@ run port serveStaticAsset backend frontend = do
9090 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e
9191 Right validFullEncoder -> do
9292 publicConfigs <- getPublicConfigs
93− backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do
94− _backend_run backend $ \serveRoute -> do
95− runSnapWithCommandLineArgs $ do
93+ backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $
94+ _backend_run backend $ \serveRoute ->
95+ runSnapWithCommandLineArgs $
9696 getRouteWith validFullEncoder >>= \case
9797 Identity r -> case r of
9898 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
9999 FullRoute_Frontend obeliskRoute :/ a ->
100− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend publicConfigs $ obeliskRoute :/ a
100+ serveDefaultObeliskApp appRouteToUrl (($ allJsUrl) <$> defaultGhcjsWidgets) serveStaticAsset frontend publicConfigs $ obeliskRoute :/ a
101+ where
102+ appRouteToUrl (k :/ v) = renderObeliskRoute validFullEncoder (FullRoute_Frontend (ObeliskRoute_App k) :/ v)
103+ allJsUrl = renderAllJsPath validFullEncoder
104+
101105 let conf = defRunConfig { _runConfig_redirectPort = port }
102106 runWidget conf publicConfigs frontend validFullEncoder `finally` killThread backendTid
103107
@@ -189,7 +193,8 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do
189193 }
190194 FullRoute_Frontend (ObeliskRoute_App appRouteComponent) :/ appRouteRest -> do
191195 let cookies = maybe [] parseCookies $ lookup (fromString "Cookie") (W.requestHeaders req)
192− html <- renderJsaddleFrontend configs cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend
196+ routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v
197+ html <- renderJsaddleFrontend configs cookies routeToUrl (appRouteComponent :/ appRouteRest) frontend
193198 sendResponse $ W.responseLBS H.status200 [("Content-Type", staticRenderContentType)] $ BSLC.fromStrict html
194199 _ -> backend req sendResponse
195200
lib/selftest/src/Obelisk/SelfTest.hs−12
@@ -27,7 +27,6 @@ import Shelly hiding (cp)
2727import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)
2828import System.Environment
2929import System.Exit (ExitCode (..))
30−import System.FilePath (replaceBaseName, takeBaseName)
3130import System.Which (staticWhich)
3231import qualified System.Info
3332import System.IO (Handle, hClose, hIsEOF, hGetContents)
@@ -217,9 +216,6 @@ main = do
217216 describe "ob run" $ {- NOT parallel $ -} do
218217 it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager
219218 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager
220− it "works with differently named cabal files" $ inTmpObInit $ \_ -> do
221− changeCabalPackageName "backend/backend.cabal" "new-backend"
222− testObRunInDir' Nothing httpManager
223219
224220 describe "obelisk project" $ parallel $ do
225221 it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImplDirty]
@@ -426,14 +422,6 @@ obRunCheck httpManager _stdout frontendUri = do
426422 req frontendUri >>= \r -> when (HTTP.responseStatus r /= HTTP.ok200) $ errorExit $
427423 "Request to frontend server failed: " <> T.pack (show r)
428424
429−-- | Rename a cabal file and do a really dumb, brittle search/replace in its content to update the name.
430−changeCabalPackageName :: FilePath -> Text -> Sh ()
431−changeCabalPackageName cabalFile newName = do
432− contents <- readfile cabalFile
433− writefile (replaceBaseName cabalFile (T.unpack newName)) $
434− T.replace (" " <> T.pack (takeBaseName cabalFile)) (" " <> newName) contents -- WARNING: Super brittle
435− rm cabalFile
436−
437425getFreePorts :: Int -> IO [Socket.PortNumber]
438426getFreePorts 0 = pure []
439427getFreePorts n = Socket.withSocketsDo $ do
skeleton/.gitignore+1
@@ -6,3 +6,4 @@ result-ios
66result-exe
77.attr-cache
88ghcid-output.txt
9+profile/