9adc07e · obelisk · git.iko.soy

ChangeLog.md+11−1

@@ -2,9 +2,19 @@

2

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

4

5+## Unreleased

6+

7+* ([#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`.

8+* ([#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`.

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

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

11+* ([#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.

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

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

14+

5## v0.8.0.0

15## v0.8.0.0

6

16

7−* ([#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 think wrapper around that.

17+* ([#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.

8* ([#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.

18* ([#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.

9

19

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

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

default.nix+16−12

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

321 __unstable__.profiledObRun = let

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

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

324+ {-# LANGUAGE NoImplicitPrelude #-}

325+ {-# LANGUAGE PackageImports #-}

324 module Main where

326 module Main where

325

327

326− import Control.Exception

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

327− import Reflex.Profiled

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

328− import System.Environment

329

330

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

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

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

334+

330− import qualified Obelisk.Run

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

331 import qualified Frontend

336 import qualified Frontend

332 import qualified Backend

337 import qualified Backend

333

338

334 main :: IO ()

339 main :: IO ()

335 main = do

340 main = do

336− args <- getArgs

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

337− let port = read $ args !! 0

338− assets = args !! 1

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

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

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

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

341 '';

344 '';

342 in nixpkgs.runCommand "ob-run" {

345 in nixpkgs.runCommand "ob-run" {

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

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

344 } ''

347 } ''

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

345− mkdir -p $out/bin/

349+ mkdir -p $out/bin

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

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

347 '';

351 '';

348

352

349 linuxExeConfigurable = linuxExe;

353 linuxExeConfigurable = linuxExe;

dep/.gitignoredeleted−5

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

1−*

2−!*/

3−!.gitignore

4−!*/*.json

5−!*/default.nix

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

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

1# DO NOT HAND-EDIT THIS FILE

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

2+import (import ./thunk.nix)

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

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

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

6− inherit owner repo rev sha256 fetchSubmodules private;

7− };

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

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

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

1{

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4− "branch": "release/0.5.3.0",

4+ "branch": "develop",

5 "private": false,

6− "rev": "9779ea3b4c87fdc971057c561262696d5e9b1847",

6+ "rev": "c21ec7036c8351185cd2feef9ce577b6a61c4f22",

7− "sha256": "0v87ilal9355xwz8y9m0zh14pm9c0f7pqch0854kkj92ybc5l62q"

7+ "sha256": "0m4sdpz6qvngralpyprrbvsyi2zmfh2l3q5vhihwfp3842blvbfg"

8}

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

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

1+# DO NOT HAND-EDIT THIS FILE

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

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

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

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

6+ inherit owner repo rev sha256 fetchSubmodules private;

7+ };

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

9+in fetch json

guides/app-deploy/README.md+14−8

@@ -1,11 +1,12 @@

1# Obelisk Application Deployment Guide

2+

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

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

3

4

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

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

5>

6>

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

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

7

8

8−## a) Get Obelisk

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

9

10

10There 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.

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

11

12

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

39

40

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

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

41

42

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

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

43

44

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

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

45

46

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

52

53

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

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

54

55

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

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

56

57

57### Import the NixOS VirtualBox appliance

58### Import the NixOS VirtualBox appliance

59+

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

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

59

61

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

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

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

201git push -u origin master

203git push -u origin master

202```

204```

203

205

204−### Deploy

206+### Initialize deployment directory

205

207

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

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

207

209

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

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

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

217```

219```

218

220

219−And deploy:

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

222+

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

224+

225+Now we can deploy to the VirtualBox VM.

220

226

221```bash

227```bash

222cd "$WORKDIR/myappdeploy"

228cd "$WORKDIR/myappdeploy"

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

243

249

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

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

245

251

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

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

247

253

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

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

249

255

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

286

292

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

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

288

294

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

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

290

296

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

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

292

298

haskell-overlays/obelisk.nix+1

@@ -20,6 +20,7 @@ in

20 librarySystemDepends = [

21 pkgs.jre

22 pkgs.nix

23+ pkgs.nix-prefetch-git

23 (haskellLib.justStaticExecutables self.ghcid)

24 (haskellLib.justStaticExecutables self.ghcid)

24 ];

25 ];

25 };

26 };

lib/asset/manifest/obelisk-asset-manifest.cabal+1−1

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

24 , template-haskell

25 , text

26 , transformers

27− , unix

27+ , unix-compat

28 , vector

29 exposed-modules:

30 Obelisk.Asset.Gather

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

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

7import qualified Data.Map as Map

8import System.Directory

9import System.FilePath.Posix

10−import System.Posix.Files

10+import System.PosixCompat.Files

11

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

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

lib/asset/serve-snap/obelisk-asset-serve-snap.cabal+1−1

@@ -23,7 +23,7 @@ library

23 , obelisk-snap-extras

24 , text

25 , transformers

26− , unix

26+ , unix-compat

27 exposed-modules:

28 Obelisk.Asset.Accept

29 Obelisk.Asset.Serve.Snap

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

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

31import System.Directory (getDirectoryContents)

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

33import System.IO.Error (isDoesNotExistError)

34−import System.Posix (getFileStatus, fileSize)

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

35

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

37--

lib/cliapp/obelisk-cliapp.cabal+2

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

19 , monad-loops

20 , mtl

21 , process

22+ , shell-escape

22 , terminal-size

23 , terminal-size

23 , text

24 , text

24 , time

25 , time

25 , transformers

26 , transformers

27+ , utf8-string

26 exposed-modules:

28 exposed-modules:

27 Obelisk.CliApp

29 Obelisk.CliApp

28 other-modules:

30 other-modules:

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

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

39 , callCommand

40 , callProcess

41 , callProcessAndLogOutput

42+ , createProcess

42 , createProcess_

43 , createProcess_

43 , overCreateProcess

44 , overCreateProcess

44 , proc

45 , proc

lib/cliapp/src/Obelisk/CliApp/Process.hs+4−2

@@ -38,6 +38,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

38import Control.Lens (Prism', review)

39import qualified Data.ByteString as BS

40import qualified Data.ByteString.Char8 as BSC

41+import qualified Data.ByteString.UTF8 as BSU

41import Data.Function (fix)

42import Data.Function (fix)

42import Data.Map (Map)

43import Data.Map (Map)

43import qualified Data.Map as Map

44import qualified Data.Map as Map

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

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

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

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

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

56import qualified System.Process as Process

57import qualified System.Process as Process

58+import Text.ShellEscape (bash, bytes)

57import qualified Data.Aeson as Aeson

59import qualified Data.Aeson as Aeson

58

60

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

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

@@ -246,8 +248,8 @@ reconstructCommand p = case p of

246 Process.ShellCommand str -> T.pack str

248 Process.ShellCommand str -> T.pack str

247 Process.RawCommand c as -> processToShellString c as

249 Process.RawCommand c as -> processToShellString c as

248 where

250 where

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

251+ processToShellString cmd args = T.pack $ unwords $

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

252+ map (BSU.toString . bytes . bash . BSU.fromString) (cmd : args)

251

253

252reconstructProcSpec :: ProcessSpec -> Text

254reconstructProcSpec :: ProcessSpec -> Text

253reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

255reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

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

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

39 , optparse-applicative

40 , placeholders

41 , process

42+ , shell-escape

42 , temporary

43 , temporary

43 , terminal-size

44 , terminal-size

44 , text

45 , text

45 , time

46 , time

46 , transformers

47 , transformers

47− , unix

48+ , unix-compat

48 , unordered-containers

49 , unordered-containers

50+ , utf8-string

49 , which

51 , which

50 , yaml

52 , yaml

51 exposed-modules:

53 exposed-modules:

lib/command/src/Obelisk/Command.hs+12−8

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

22import System.FilePath

23import qualified System.Info

24import System.IO (hIsTerminalDevice, stdout)

25−import System.Posix.Process (executeFile)

25+import System.Process (rawSystem)

26

27import Obelisk.App

28import Obelisk.CliApp

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

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

115 , 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"

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

117+ , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies or run a command in such a shell. E.g. ob shell -- ghc-pkg list"

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

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

120 <> footerDoc (Just $

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

285shellOpts = ShellOpts

286 <$> shellFlags

287 <*> interpretOpts

288+ -- This funny construction is used to support optparse-applicative's @--@ parsing.

289+ -- All arguments after @--@ are left unparsed and instead provided to the last positional parser

290+ -- which must therefore be 'many' in order to consume the rest of the input.

288− <*> optional (strArgument (metavar "COMMAND"))

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

289

292

290portOpt :: Int -> Parser Int

293portOpt :: Int -> Parser Int

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

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

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

363 Just impl -> do

366 Just impl -> do

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

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

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

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

366− liftIO $ executeFile impl False ("--no-handoff" : myArgs) Nothing

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

370+ return ()

367 case myArgs of

371 case myArgs of

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

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

369 origPath:inPath:outPath:preprocessorName:packagePaths

373 origPath:inPath:outPath:preprocessorName:packagePaths

@@ -398,11 +402,11 @@ ob = \case

398 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

402 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

399 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

403 ObCommand_Watch interpretPathsList -> withInterpretPaths interpretPathsList runWatch

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

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

401− nixShellForInterpretPaths False shellAttr root interpretPaths cmd

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

402− ObCommand_Doc shellAttr pkgs -> withProjectRoot "." $ \root ->

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

403− nixShellForInterpretPaths True shellAttr root emptyPathTree $ Just $ haddockCommand pkgs

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

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

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

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

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

406 ObCommand_Internal icmd -> case icmd of

410 ObCommand_Internal icmd -> case icmd of

407 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

411 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

408 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

412 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

lib/command/src/Obelisk/Command/Deploy.hs+1−1

@@ -25,7 +25,7 @@ import GHC.Generics

25import System.Directory

26import System.FilePath

27import System.IO

28−import System.Posix.Files

28+import System.PosixCompat.Files

29import Text.URI (URI)

30import qualified Text.URI as URI

31import Text.URI.Lens

lib/command/src/Obelisk/Command/Project.hs+14−7

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

15 , toImplDir

16 , toObeliskDir

17 , withProjectRoot

18+ , bashEscape

18 ) where

19 ) where

19

20

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

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

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

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

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

24import Control.Monad.State

25import Control.Monad.State

25import qualified Data.Aeson as Json

26import qualified Data.Aeson as Json

27+import qualified Data.ByteString.UTF8 as BSU

26import Data.Bits

28import Data.Bits

27import qualified Data.ByteString.Lazy as BSL

29import qualified Data.ByteString.Lazy as BSL

28import Data.Default (def)

30import Data.Default (def)

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

30import Data.Map (Map)

32import Data.Map (Map)

31import Data.Text (Text)

33import Data.Text (Text)

32import qualified Data.Text as T

34import qualified Data.Text as T

33−import Data.Text.Encoding (decodeUtf8)

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

34import Data.Traversable (for)

36import Data.Traversable (for)

35import System.Directory

37import System.Directory

36import System.Environment (lookupEnv)

38import System.Environment (lookupEnv)

37import System.FilePath

39import System.FilePath

38import System.IO.Temp

40import System.IO.Temp

39import System.IO.Unsafe (unsafePerformIO)

41import System.IO.Unsafe (unsafePerformIO)

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

42+import System.PosixCompat.Files

41−import System.Posix.Files

43+import System.PosixCompat.Types

44+import System.PosixCompat.User

45+import Text.ShellEscape (bash, bytes)

42

46

43import GitHub.Data.GitData (Branch)

47import GitHub.Data.GitData (Branch)

44import GitHub.Data.Name (Name)

48import GitHub.Data.Name (Name)

@@ -278,12 +282,15 @@ nixShellRunConfig root isPure command = do

278 pure $ def

282 pure $ def

279 & nixShellConfig_pure .~ isPure

283 & nixShellConfig_pure .~ isPure

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

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

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

285+ & nixShellConfig_run .~ (command <&> \cs -> unwords $ concat

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

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

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

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

284− , c

288+ , [cs]

285 ])

289 ])

286

290

291+bashEscape :: String -> String

292+bashEscape = BSU.toString . bytes . bash . BSU.fromString

293+

287nixShellRunProc :: NixShellConfig -> ProcessSpec

294nixShellRunProc :: NixShellConfig -> ProcessSpec

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

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

289

296

lib/command/src/Obelisk/Command/Run.hs+57−45

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

25import Data.Either (partitionEithers)

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

27import Data.Functor.Identity (runIdentity)

28+import Data.List (intercalate)

28import Data.List.NonEmpty (NonEmpty)

29import Data.List.NonEmpty (NonEmpty)

29import qualified Data.List.NonEmpty as NE

30import qualified Data.List.NonEmpty as NE

30import Data.Map (Map)

31import Data.Map (Map)

31import qualified Data.Map as Map

32import qualified Data.Map as Map

32import qualified Data.Map.Monoidal as MMap

33import qualified Data.Map.Monoidal as MMap

33−import Data.Maybe

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

35+import Data.Ord (comparing)

34import Data.Set (Set)

36import Data.Set (Set)

35import qualified Data.Set as Set

37import qualified Data.Set as Set

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

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

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

44import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

46import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

45import Distribution.Parsec.ParseResult (runParseResult)

47import Distribution.Parsec.ParseResult (runParseResult)

46import qualified Distribution.System as Dist

48import qualified Distribution.System as Dist

47−import Distribution.Types.BuildInfo

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

48−import Distribution.Types.CondTree

50+import Distribution.Types.CondTree (simplifyCondTree)

49−import Distribution.Types.GenericPackageDescription

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

50−import Distribution.Types.Library

52+import Distribution.Types.Library (libBuildInfo)

51−import Distribution.Utils.Generic

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

52import qualified Distribution.Parsec.Common as Dist

54import qualified Distribution.Parsec.Common as Dist

53import qualified Hpack.Config as Hpack

55import qualified Hpack.Config as Hpack

54import qualified Hpack.Render as Hpack

56import qualified Hpack.Render as Hpack

55import qualified Hpack.Yaml as Hpack

57import qualified Hpack.Yaml as Hpack

56−import Language.Haskell.Extension

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

57−import Network.Socket hiding (Debug)

59+import qualified Network.Socket as Socket

58import System.Directory

60import System.Directory

59import System.Environment (getExecutablePath)

61import System.Environment (getExecutablePath)

60import System.FilePath

62import System.FilePath

@@ -76,7 +78,7 @@ import Obelisk.CliApp (

76 withSpinner,

78 withSpinner,

77 )

79 )

78import Obelisk.Command.Nix

80import Obelisk.Command.Nix

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

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

80import Obelisk.Command.Thunk (attrCacheFileName)

82import Obelisk.Command.Thunk (attrCacheFileName)

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

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

82

84

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

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

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

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

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

111

113

112−emptyPathTree :: PathTree a

113−emptyPathTree = PathTree_Node Nothing mempty

114−

115-- | 2D ASCII drawing of a 'PathTree'. Adapted from Data.Tree.draw.

114-- | 2D ASCII drawing of a 'PathTree'. Adapted from Data.Tree.draw.

116drawPathTree :: (a -> Text) -> PathTree a -> Text

115drawPathTree :: (a -> Text) -> PathTree a -> Text

117drawPathTree showA (PathTree_Node _ ts0) = T.intercalate "\n" $ goForest (Map.toList ts0)

116drawPathTree showA (PathTree_Node _ ts0) = T.intercalate "\n" $ goForest (Map.toList ts0)

@@ -164,12 +163,12 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do

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

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

165run root interpretPaths = do

164run root interpretPaths = do

166 pkgs <- getParsedLocalPkgs root interpretPaths

165 pkgs <- getParsedLocalPkgs root interpretPaths

167− withGhciScript pkgs $ \dotGhciPath -> do

168− assets <- findProjectAssets root

166+ assets <- findProjectAssets root

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

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

170− ghciArgs <- getGhciSessionSettings pkgs root True

168+ ghciArgs <- getGhciSessionSettings pkgs root True

171− freePort <- getFreePort

169+ freePort <- getFreePort

170+ withGhciScriptArgs pkgs $ \dotGhciArgs -> do

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

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

173 [ "Obelisk.Run.run"

172 [ "Obelisk.Run.run"

174 , show freePort

173 , show freePort

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

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

@@ -181,15 +180,15 @@ runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

181runRepl root interpretPaths = do

180runRepl root interpretPaths = do

182 pkgs <- getParsedLocalPkgs root interpretPaths

181 pkgs <- getParsedLocalPkgs root interpretPaths

183 ghciArgs <- getGhciSessionSettings pkgs "." True

182 ghciArgs <- getGhciSessionSettings pkgs "." True

184− withGhciScript pkgs $ \dotGhciPath ->

183+ withGhciScriptArgs pkgs $ \dotGhciArgs ->

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

184+ runGhciRepl root pkgs (ghciArgs <> dotGhciArgs)

186

185

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

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

188runWatch root interpretPaths = do

187runWatch root interpretPaths = do

189 pkgs <- getParsedLocalPkgs root interpretPaths

188 pkgs <- getParsedLocalPkgs root interpretPaths

190 ghciArgs <- getGhciSessionSettings pkgs root True

189 ghciArgs <- getGhciSessionSettings pkgs root True

191− withGhciScript pkgs $ \dotGhciPath ->

190+ withGhciScriptArgs pkgs $ \dotGhciArgs ->

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

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

193

192

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

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

195exportGhciConfig useRelativePaths root interpretPaths = do

194exportGhciConfig useRelativePaths root interpretPaths = do

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

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

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

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

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

398

397

398+-- Like 'withGhciScript' but provides the precise ghci arguments to add to a ghci session

399+withGhciScriptArgs

400+ :: (MonadObelisk m, Foldable f)

401+ => f CabalPackageInfo -- ^ List of packages to load into ghci

402+ -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments

403+ -> m ()

404+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]

405+ where

406+ -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@

407+ -- is passed to the ghci session.

408+ loadPreludeManually =

409+ [ ":add Prelude" -- @:add@ is used because it's less noisy when there is no custom Prelude

410+ , ":set -XImplicitPrelude" -- Turn the default setting on

411+ ]

412+

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

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

400withGhciScript

414withGhciScript

401 :: (MonadObelisk m, Foldable f)

415 :: (MonadObelisk m, Foldable f)

416+ => [String] -- ^ Commands to prefix to file

402− => f CabalPackageInfo -- ^ List of packages to load into ghci

417+ -> f CabalPackageInfo -- ^ List of packages to load into ghci

403 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

418 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

404 -> m ()

419 -> m ()

405−withGhciScript (toList -> packageInfos) f =

420+withGhciScript preCommands (toList -> packageInfos) f =

406 withSystemTempDirectory "ob-ghci" $ \fp -> do

421 withSystemTempDirectory "ob-ghci" $ \fp -> do

407 let dotGhciPath = fp </> ".ghci"

422 let dotGhciPath = fp </> ".ghci"

408 liftIO $ writeFile dotGhciPath dotGhci

423 liftIO $ writeFile dotGhciPath dotGhci

@@ -414,7 +429,8 @@ withGhciScript (toList -> packageInfos) f =

414 , [ "Backend" | "backend" `Set.member` packageNames ]

429 , [ "Backend" | "backend" `Set.member` packageNames ]

415 , [ "Frontend" | "frontend" `Set.member` packageNames ]

430 , [ "Frontend" | "frontend" `Set.member` packageNames ]

416 ]

431 ]

417− dotGhci = unlines

432+ dotGhci = unlines $

433+ preCommands <>

418 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

434 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad

419 , "import qualified Obelisk.Run"

435 , "import qualified Obelisk.Run"

420 , "import qualified Frontend"

436 , "import qualified Frontend"

@@ -467,7 +483,7 @@ runGhciRepl root (toList -> packages) ghciArgs =

467 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

483 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the

468 -- ghc that is provided by the shell in the user's project.

484 -- ghc that is provided by the shell in the user's project.

469 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

485 nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $

470− Just $ unwords $ "ghci" : ghciArgs -- TODO: Shell escape

486+ Just $ unwords $ fmap bashEscape $ "ghci" : ghciArgs

471

487

472-- | Run ghcid

488-- | Run ghcid

473runGhcid

489runGhcid

@@ -480,32 +496,28 @@ runGhcid

480 -> m ()

496 -> m ()

481runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

497runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =

482 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

498 nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $

483− Just $ unwords $ ghcidExePath : opts -- TODO: Shell escape

499+ Just $ unwords $ fmap bashEscape $ ghcidExePath : opts

484 where

500 where

485− opts =

501+ opts = concat

486− [ "-W"

502+ [ ["-W"]

487− , "--outputfile=ghcid-output.txt"

503+ , ["--outputfile=ghcid-output.txt"]

488− ] <> map (\x -> "--reload='" <> x <> "'") reloadFiles

504+ , map (\x -> "--reload=" <> x) reloadFiles

489− <> map (\x -> "--restart='" <> x <> "'") restartFiles

505+ , map (\x -> "--restart=" <> x) restartFiles

490− <> testCmd

506+ , maybe [] (\cmd -> ["--test=" <> cmd]) mcmd

491− <> ["--command='" <> unwords ("ghci" : ghciArgs) <> "'"] -- TODO: Shell escape

507+ , ["--command=" <> unwords ("ghci" : ghciArgs)]

492− testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'") -- TODO: Shell escape

508+ ]

493−

494 adjustRoot x = if chdirToRoot then makeRelative root x else x

509 adjustRoot x = if chdirToRoot then makeRelative root x else x

495 reloadFiles = map adjustRoot [root </> "config"]

510 reloadFiles = map adjustRoot [root </> "config"]

496 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

511 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages

497

512

498−mkGhciScriptArg :: FilePath -> [String]

499−mkGhciScriptArg dotGhci = ["-ghci-script", dotGhci]

500−

501−getFreePort :: MonadIO m => m PortNumber

513+getFreePort :: MonadIO m => m Socket.PortNumber

502−getFreePort = liftIO $ withSocketsDo $ do

514+getFreePort = liftIO $ Socket.withSocketsDo $ do

503− addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")

515+ addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")

504− bracket (open addr) close socketPort

516+ bracket (open addr) Socket.close Socket.socketPort

505 where

517 where

506 open addr = do

518 open addr = do

507− sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

519+ sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)

508− bind sock (addrAddress addr)

520+ Socket.bind sock (Socket.addrAddress addr)

509 return sock

521 return sock

510

522

511

523

lib/command/src/Obelisk/Command/Thunk.hs+3−3

@@ -56,7 +56,7 @@ import System.Exit

56import System.FilePath

57import System.IO.Error

58import System.IO.Temp

59−import System.Posix (getSymbolicLinkStatus, modificationTime)

59+import System.PosixCompat.Files (getSymbolicLinkStatus, modificationTime)

60import qualified Text.URI as URI

61

62import Obelisk.App (MonadObelisk)

@@ -178,14 +178,14 @@ getNixSha256ForUriUnpacked

178getNixSha256ForUriUnpacked uri =

179 withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

180 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

181− proc "nix-prefetch-url" ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

181+ proc nixPrefetchUrlPath ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

182 pure hash

183

184nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

185nixPrefetchGit uri rev fetchSubmodules =

186 withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

187 out <- readProcessAndLogStderr Debug $

188− proc "nix-prefetch-git" $ filter (/="")

188+ proc nixPrefetchGitPath $ filter (/="")

189 [ "--url", T.unpack $ gitUriToText uri

190 , "--rev", T.unpack rev

191 , if fetchSubmodules then "--fetch-submodules" else ""

lib/command/src/Obelisk/Command/Utils.hs+6

@@ -54,6 +54,12 @@ 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+

57-- | Nix syntax requires relative paths to be prefixed by @./@ or

63-- | Nix syntax requires relative paths to be prefixed by @./@ or

58-- @../@. This will make a 'FilePath' that can be embedded in a Nix

64-- @../@. This will make a 'FilePath' that can be embedded in a Nix

59-- expression.

65-- expression.

lib/frontend/src/Obelisk/Frontend.hs+1−1

@@ -182,7 +182,7 @@ runFrontendWithConfigsAndCurrentRoute

182 -> Frontend (R frontendRoute)

183 -> JSM ()

184runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = do

185− let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

185+ let ve = validFullEncoder . hoistParse errorLeft (reviewEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

186 errorLeft = \case

187 Left _ -> error "runFrontend: Unexpected non-app ObeliskRoute reached the frontend. This shouldn't happen."

188 Right x -> Identity x

lib/route/src/Obelisk/Route.hs+70−27

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ApplicativeDo #-}

2{-# LANGUAGE ApplicativeDo #-}

2{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE EmptyCase #-}

4{-# LANGUAGE EmptyCase #-}

@@ -61,6 +62,7 @@ module Obelisk.Route

61 , justEncoder

62 , justEncoder

62 , nothingEncoder

63 , nothingEncoder

63 , isoEncoder

64 , isoEncoder

65+ , viewEncoder

64 , wrappedEncoder

66 , wrappedEncoder

65 , unwrappedEncoder

67 , unwrappedEncoder

66 , listToNonEmptyEncoder

68 , listToNonEmptyEncoder

@@ -69,6 +71,7 @@ module Obelisk.Route

69 , toListMapEncoder

71 , toListMapEncoder

70 , shadowEncoder

72 , shadowEncoder

71 , prismEncoder

73 , prismEncoder

74+ , reviewEncoder

72 , rPrism

75 , rPrism

73 , _R

76 , _R

74 , obeliskRouteEncoder

77 , obeliskRouteEncoder

@@ -133,6 +136,7 @@ import Control.Lens

133 , Prism'

136 , Prism'

134 , prism'

137 , prism'

135 , re

138 , re

139+ , review

136 , view

140 , view

137 , Wrapped (..)

141 , Wrapped (..)

138 )

142 )

@@ -221,7 +225,19 @@ hoistR f (x :=> Identity y) = f x :/ y

221infixr 5 :.

225infixr 5 :.

222type (:.) = (,)

226type (:.) = (,)

223

227

228+#ifdef __GLASGOW_HASKELL__

229+#if __GLASGOW_HASKELL__ >= 810

224{-# COMPLETE (:.) #-}

230{-# COMPLETE (:.) #-}

231+#else

232+{-# WARNING (:.)

233+ [ "Use of this pattern in GHC < 8.10 will result in spurious non-exhaustive warnings at every use site."

234+ , "We cannot provide a COMPLETE pragma to silence these due to a GHC bug: https://gitlab.haskell.org/ghc/ghc/issues/17729."

235+ , "The bug hides incompleteness warnings for all two tuples when the COMPLETE pattern is in scope."

236+ , "Instead, you should use (,) directly until you can switch to GHC >= 8.10, where the COMPLETE pragma is reinstated."

237+ ]

238+ #-}

239+#endif

240+#endif

225pattern (:.) :: a -> b -> a :. b

241pattern (:.) :: a -> b -> a :. b

226pattern a :. b = (a, b)

242pattern a :. b = (a, b)

227

243

@@ -340,7 +356,7 @@ instance Monad parse => Bifunctor (,) (EncoderImpl parse) (EncoderImpl parse) (E

340 }

356 }

341

357

342instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

358instance (Monad parse, Applicative check) => Braided (Encoder check parse) (,) where

343− braid = isoEncoder (iso swap swap)

359+ braid = viewEncoder (iso swap swap)

344

360

345

361

346instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

362instance (Applicative check, Monad parse) => PFunctor (,) (Encoder check parse) (Encoder check parse) where

@@ -376,11 +392,11 @@ instance (Monad parse, Applicative check) => Bifunctor Either (Encoder check par

376 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

392 bimap f g = Encoder $ liftA2 bimap (unEncoder f) (unEncoder g)

377

393

378instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

394instance (Applicative check, Monad parse) => Associative (Encoder check parse) Either where

379− associate = isoEncoder (iso (associate @(->) @Either) disassociate)

395+ associate = viewEncoder (iso (associate @(->) @Either) disassociate)

380− disassociate = isoEncoder (iso disassociate associate)

396+ disassociate = viewEncoder (iso disassociate associate)

381

397

382instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

398instance (Monad parse, Applicative check) => Braided (Encoder check parse) Either where

383− braid = isoEncoder (iso swap swap)

399+ braid = viewEncoder (iso swap swap)

384

400

385

401

386

402

@@ -434,17 +450,17 @@ instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,)

434--------------------------------------------------------------------------------

450--------------------------------------------------------------------------------

435

451

436-- | Given a valid 'Iso' from lens, construct an 'Encoder'

452-- | Given a valid 'Iso' from lens, construct an 'Encoder'

437−isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

453+viewEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

438−isoEncoder f = unsafeMkEncoder $ EncoderImpl

454+viewEncoder f = unsafeMkEncoder $ EncoderImpl

439 { _encoderImpl_encode = view f

455 { _encoderImpl_encode = view f

440 , _encoderImpl_decode = pure . view (from f)

456 , _encoderImpl_decode = pure . view (from f)

441 }

457 }

442

458

443wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

459wrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse (Unwrapped a) a

444−wrappedEncoder = isoEncoder $ from _Wrapped'

460+wrappedEncoder = viewEncoder $ from _Wrapped'

445

461

446unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

462unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)

447−unwrappedEncoder = isoEncoder _Wrapped'

463+unwrappedEncoder = viewEncoder $ _Wrapped'

448

464

449maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

465maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)

450maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

466maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl

@@ -469,11 +485,11 @@ maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder

469

485

470-- | Encode a value by simply applying 'Just'

486-- | Encode a value by simply applying 'Just'

471justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

487justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)

472−justEncoder = prismEncoder _Just

488+justEncoder = reviewEncoder _Just

473

489

474-- | Encode () to 'Nothing'.

490-- | Encode () to 'Nothing'.

475nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

491nothingEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse () (Maybe a)

476−nothingEncoder = prismEncoder _Nothing

492+nothingEncoder = reviewEncoder _Nothing

477

493

478someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

494someConstEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Some (Const a)) a

479someConstEncoder = unsafeMkEncoder $ EncoderImpl

495someConstEncoder = unsafeMkEncoder $ EncoderImpl

@@ -827,12 +843,19 @@ _R variant = dSumGEqPrism variant . iso runIdentity Identity

827

843

828-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

844-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

829-- if the prism doesn't match.

845-- if the prism doesn't match.

846+--

847+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@

848+-- (i.e. 'reviewEncoder' is a contravariant functor from the category of prisms to the category of encoders),

849+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might

850+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;

851+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their

852+-- reverse direction. In short @reviewEncoder (f . g) = reviewEncoder g . reviewEncoder f@.

830−prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

853+reviewEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

831−prismEncoder p = unsafeMkEncoder $ EncoderImpl

854+reviewEncoder p = unsafeMkEncoder $ EncoderImpl

832− { _encoderImpl_encode = (^. re p)

855+ { _encoderImpl_encode = review p

833 , _encoderImpl_decode = \r -> case r ^? p of

856 , _encoderImpl_decode = \r -> case r ^? p of

834 Just a -> pure a

857 Just a -> pure a

835− Nothing -> throwError "prismEncoder: value is not present in the prism"

858+ Nothing -> throwError "reviewEncoder: value is not present in the prism"

836 }

859 }

837

860

838-- | A URL path and query string, in which trailing slashes don't matter in the path

861-- | A URL path and query string, in which trailing slashes don't matter in the path

@@ -1028,17 +1051,6 @@ void1Encoder = Encoder $ pure $ EncoderImpl

1028instance GShow Void1 where

1051instance GShow Void1 where

1029 gshowsPrec _ = \case {}

1052 gshowsPrec _ = \case {}

1030

1053

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−

1042-- | Given a backend route and a checked route encoder, render the route (path

1054-- | Given a backend route and a checked route encoder, render the route (path

1043-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1055-- and query string). See 'checkEncoder' for how to produce a checked encoder.

1044renderBackendRoute

1056renderBackendRoute

@@ -1071,11 +1083,11 @@ readShowEncoder :: (MonadError Text parse, Read a, Show a, Applicative check) =>

1071readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1083readShowEncoder = singlePathSegmentEncoder . unsafeTshowEncoder

1072

1084

1073integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1085integralEncoder :: (MonadError Text parse, Applicative check, Integral a) => Encoder check parse a Integer

1074−integralEncoder = prismEncoder (Numeric.Lens.integral)

1086+integralEncoder = reviewEncoder (Numeric.Lens.integral)

1075

1087

1076pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1088pathSegmentEncoder :: (MonadError Text parse, Applicative check, Cons as as a a) =>

1077 Encoder check parse (a, (as, b)) (as, b)

1089 Encoder check parse (a, (as, b)) (as, b)

1078−pathSegmentEncoder = first (prismEncoder _Cons) . disassociate

1090+pathSegmentEncoder = first (reviewEncoder _Cons) . disassociate

1079

1091

1080newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1092newtype Decoder check parse b a = Decoder { toEncoder :: Encoder check parse a b }

1081

1093

@@ -1182,3 +1194,34 @@ byteStringsToPageName p q =

1182 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1194 in decode pageNameEncoder' (T.unpack (T.decodeUtf8 p), T.unpack (T.decodeUtf8 q))

1183

1195

1184--TODO: decodeURIComponent as appropriate

1196--TODO: decodeURIComponent as appropriate

1197+

1198+

1199+{-# DEPRECATED isoEncoder "Instead of 'isoEncoder f', use 'viewEncoder f'" #-}

1200+-- | Given a valid 'Iso' from lens, construct an 'Encoder'

1201+isoEncoder :: (Applicative check, Applicative parse) => Iso' a b -> Encoder check parse a b

1202+isoEncoder = viewEncoder

1203+

1204+{-# DEPRECATED prismEncoder "Instead of 'prismEncoder f', use 'reviewEncoder f'" #-}

1205+-- | An encoder that only works on the items available via the prism. An error will be thrown in the parse monad

1206+-- if the prism doesn't match.

1207+--

1208+-- Note that a 'Prism' from @a@ to @b@ will produce an 'Encoder' from @b@ to @a@

1209+-- (i.e. 'prismEncoder' is a contravariant functor from the category of prisms to the category of encoders),

1210+-- just like 'review' produces a function @b -> a@. This is because 'Prism's extract values, in a way that might

1211+-- fail, in their forward direction and inject values, in a way that cannot fail, in their reverse direction;

1212+-- whereas 'Encoder's encode, which cannot fail, in their forward direction, and decode, which can fail, in their

1213+-- reverse direction. In short @prismEncoder (f . g) = prismEncoder g . prismEncoder f@.

1214+prismEncoder :: (Applicative check, MonadError Text parse) => Prism' b a -> Encoder check parse a b

1215+prismEncoder = reviewEncoder

1216+

1217+

1218+concat <$> mapM deriveRouteComponent

1219+ [ ''ResourceRoute

1220+ , ''JSaddleWarpRoute

1221+ , ''IndexOnlyRoute

1222+ ]

1223+

1224+makePrisms ''ObeliskRoute

1225+makePrisms ''FullRoute

1226+deriveGEq ''Void1

1227+deriveGCompare ''Void1

lib/selftest/src/Obelisk/SelfTest.hs+7

@@ -243,6 +243,8 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

243 uu <- update

244 assertRevEQ u uu

245

246+ it "can run 'ob doc'" $ inTmpObInit $ \_ -> runOb_ ["doc", "reflex"]

247+

246 describe "ob thunk pack/unpack" $ parallel $ do

248 describe "ob thunk pack/unpack" $ parallel $ do

247 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

249 it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

248

250

@@ -304,6 +306,11 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

304 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

306 void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]

305 checkDir dir >>= liftIO . assertEqual "" startingContents

307 checkDir dir >>= liftIO . assertEqual "" startingContents

306

308

309+ describe "ob shell" $ parallel $ do

310+ it "works with --" $ inTmpObInit $ \_ -> do

311+ output <- runOb ["shell", "--", "ghc-pkg", "list"]

312+ liftIO $ assertBool "Unexpected output from ob shell" $ ("Cabal-" `T.isInfixOf` output) && ("ghc-" `T.isInfixOf` output)

313+

307 describe "ob hoogle" $ {- NOT parallel -} do

314 describe "ob hoogle" $ {- NOT parallel -} do

308 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

315 it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do

309 [p0] <- liftIO $ getFreePorts 1

316 [p0] <- liftIO $ getFreePorts 1

lib/snap-extras/obelisk-snap-extras.cabal−1

@@ -12,7 +12,6 @@ library

12 , base

13 , bytestring

14 , snap-core

15− , unix

16 , directory

15 , directory

17 , filepath

16 , filepath

18 , text

17 , text

skeleton/frontend/frontend.cabal+4−2

@@ -28,7 +28,9 @@ executable frontend

28 , reflex-dom

29 , obelisk-generated-static

30 , frontend

31− --TODO: Make these ghc-options optional

32 ghc-options: -threaded

31 ghc-options: -threaded

32+ if impl(ghcjs)

33+ ghc-options: -dedupe

34+ cpp-options: -DGHCJS_BROWSER

33 if os(darwin)

35 if os(darwin)

34− ghc-options: -dynamic

36+ ghc-options: -dynamic