de99fc6 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge branch 'release/0.1.1.0'

* release/0.1.1.0: (45 commits) Fix release.nix; release v0.1.1.0 Add changelog for forced-packing of thunks; update warning message Update README.md Add option to force pack thunks Add `dynRouteLink` Allow skeleton's obelisk to be overridden and fix release.nix (#420) Accept android sdk license for hydra (#422) Add HasFrontendConfigs on Performable in ObeliskWidget Fix PerformEvent instance for FrontendConfigsT Fix frontend configs in right hand side of prerender Use data- attribute to identify config key/value pairs Fix selftest Update ChangeLog.md for executable-config changes Split out backend and frontend monad transformers for config lookup Update ChangeLog.md for removing MonadIO from ObeliskWidget Only remove configs from head in GHCJS / ob run Remove MonadIO in prerendering Remove old "get" config function and move getFrontendConfigs out of Internal Make getFrontendConfigs return a Map and abstract out directory listing Remove some unused imports ...

commitde99fc6178fe64f6ea3176746e9c273c92fb8e45 authorAli Abrar <aliabrar@gmail.com> dateFri 17 May 2019, 23:30 (7 years ago) parentad3fef1 a53eee2

44 files changed+790−235

compare with master

unifiedsplit

CONTRIBUTING.md+3

@@ -28,6 +28,9 @@ The summary line of your commit message should summarize the changes being made.

2828One way to think about it is that your commit message should be able to complete the sentence:

2929"When applied, this commit will..."

3030

31+##### Note on bumping dependencies

32+Commits that update a dependency should include some information about why the dependency was updated in the commit message.

33+

3134#### Body

3235For breaking changes, new features, refactors, or other major changes, the body of the commit message should describe the motivation behind the change in greater detail and may include references to the issue tracker. The body shouldn't repeat code/comments from the diff.

3336

ChangeLog.md+16

@@ -2,6 +2,22 @@

33This 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, and the date should reflect that release.

5+## Unreleased

8+## v0.1.1.0 - 2019-05-17

10+* Fix crashes of Android apps on 32-bit ARM devices.

11+* Provide a way to indicate acceptance of the Android SDK license by passing `config.android_sdk.accept_license = true;` in the arguments to the import of `.obelisk/impl` in the project's `default.nix`.

12+* Add `COMPLETE` pragma to `(:/)`. Using this pattern synonym should no longer generate spurious warnings about non-exhaustive pattern matching.

13+* Make asset path hashing strict (see `Obelisk.Asset.Gather`)

14+* Add the `ob shell` command to enter a nix shell for an obelisk project

15+* Allow skeleton's obelisk to be overridden. This changes the skeleton's default.nix interface: the arguments that it used to take are now part of the new "obelisk" argument.

16+* Removed `MonadIO` from `ObeliskWidget` to prevent accidental IO during prerendering. If you need to do IO in a widget it should be on the right hand side of a `prerender`.

17+* Significantly changed the interface to the "executable config" packages. `obelisk-executable-config-lookup` is a new internal package which looks up all configs in a platform-specific way. `obelisk-executable-frontend` and `obelisk-executable-backend` provide MTL-style monad classes (`HasFrontendConfigs` and `HasBackendConfigs`) which the frontend and backend, respectively, can use to look up configs. This replaces the old `get` function which ran in `IO`.

18+* Add a flag to force thunk packing even if there are unpushed changes in the unpacked thunk.

19+

20+

521## v0.1.0.0 - 2019-03-29

622

723* Use reflex-dom's `HydrationDomBuilder` to "hydrate" statically rendered DOM served by the Obelisk backend (rather than re-creating DOM and replacing it all).

FAQ.md+76

@@ -2,6 +2,8 @@

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

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

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

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

68### How do I fix invalid entitlements?

@@ -44,3 +46,77 @@ ob thunk pack $SOME_THUNK

4446Substitute the directory of your thunk for `$SOME_THUNK`. In the case of `ob deploy update`, `$SOME_THUNK` will be `src` in the deployment directory.

4547

4648(Based on issue #351).

49+

50+### How do I fix `Ambiguous module name` errors?

51+Since obelisk places the common/backend/frontend modules packages into the same ghci, and ghci doesn't "sandbox" them, it is possible to have conflicting module errors inside `ob repl/watch/run` that do not appear when doing a cabal build.

52+

53+You can disambiguate this via [PackageImports](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#package-qualified-imports). For instance, if you see

54+```

55+error:

56+ Ambiguous module name ‘Crypto.Hash’:

57+ it was found in multiple packages:

58+ cryptohash-0.11.9 cryptonite-0.25

59+```

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

61+`import "cryptonite" Crypto.Hash`

62+

63+

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

65+

66+

67+#### Short version:

68+

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

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

71+project's dependencies and,

72+

73+* either displays compilation errors/warnings,

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

75+ * your backend's route handlers,

76+ * the static assets,

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

78+

79+#### Longer version:

80+

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

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

83+

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

85+

86+where

87+

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

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

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

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

92+

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

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

95+

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

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

98+ * obtains a free port number.

99+* Then runs `ghcid`

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

101+ `--test`).

102+

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

104+

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

106+ This runs `runSnapWithCommandLineArgs` and passes routes:

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

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

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

110+ serve static assets.

111+* Starts `runWidget`

112+ which itself runs

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

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

115+ * it binds to TCP socket, and

116+ * creates the HTTP connection manager

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

118+ * calls `obeliskApp` which

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

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

121+ * starts the JSaddle web-socket,

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

README.md+3−1

@@ -24,6 +24,7 @@ Obelisk provides an easy way to develop and deploy your [Reflex](https://github.

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

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

2626 ```

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

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

2829 ```

2930 substituters = https://cache.nixos.org https://nixcache.reflex-frp.org

@@ -81,7 +82,7 @@ Obelisk leverages ghcid to provide a live-reloading server that handles both fro

8182ob run

8283```

8384

84−Now go to http://localhost:8000 (or the port specified in `config/common/route`) to access your app.

85+Now go to http://localhost:8000 (or the address/port specified in `config/common/route`) to access your app.

8586

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

8788

@@ -272,6 +273,7 @@ It's also possible to inspect iOS WkWebView apps once they are installed in the

272273NOTE: Currently Android builds are only supported on Linux.

273274

2742751. In your project's `default.nix` set a suitable value for `android.applicationId` and `android.displayName`.

276+1. In your project's `default.nix` pass `config.android_sdk.accept_license = true;` in the arguments to the import of of `.obelisk/impl` to indicate your acceptance of the [Android Software Development Kit License Agreement](https://developer.android.com/studio/terms), which is required to build Android apps.

2752771. Run `nix-build -A android.frontend -o result-android` to build the Android app.

2762781. A debug version of the app should be generated at `result-android/android-app-debug.apk`

277279

default.nix+11−9

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

11{ system ? builtins.currentSystem

22, profiling ? false

33, iosSdkVersion ? "10.2"

4+, config ? {}

45}:

56let

67 cleanSource = builtins.filterSource (name: _: let baseName = builtins.baseNameOf name; in !(

@@ -16,7 +17,7 @@ let

1617 ];

1718

1819 getReflexPlatform = sys: import ./dep/reflex-platform {

19− inherit iosSdkVersion;

20+ inherit iosSdkVersion config;

2021 system = sys;

2122 enableLibraryProfiling = profiling;

2223

@@ -48,11 +49,12 @@ let

4849 } + /template) {};

4950 })

5051

52+ pkgs.obeliskExecutableConfig.haskellOverlay

53+

5154 # Add obelisk packages

5255 (self: super: let

5356 pkgs = self.callPackage ({ pkgs }: pkgs) {};

5457 in {

55− obelisk-executable-config = pkgs.obeliskExecutableConfig.haskellPackage self;

5658 obelisk-executable-config-inject = pkgs.obeliskExecutableConfig.platforms.web.inject self;

5759

5860 obelisk-asset-manifest = self.callCabal2nix "obelisk-asset-manifest" (hackGet ./lib/asset + "/manifest") {};

@@ -298,21 +300,21 @@ in rec {

298300 injectableConfig = builtins.filterSource (path: _:

299301 !(lib.lists.any (x: hasPrefix (toString base + "/" + toString x) (toString path)) privateConfigDirs)

300302 );

301− __android = configPath: {

303+ __androidWithConfig = configPath: {

302304 ${if android == null then null else frontendName} = {

303305 executableName = "frontend";

304306 ${if builtins.pathExists staticFiles then "assets" else null} =

305307 nixpkgs.obeliskExecutableConfig.platforms.android.inject

306− (if configPath == null then null else injectableConfig configPath)

308+ (injectableConfig configPath)

307309 processedStatic.symlinked;

308310 } // android;

309311 };

310− __ios = configPath: {

312+ __iosWithConfig = configPath: {

311313 ${if ios == null then null else frontendName} = {

312314 executableName = "frontend";

313315 ${if builtins.pathExists staticFiles then "staticSrc" else null} =

314316 nixpkgs.obeliskExecutableConfig.platforms.ios.inject

315− (if configPath == null then null else injectableConfig configPath)

317+ (injectableConfig configPath)

316318 processedStatic.symlinked;

317319 } // ios;

318320 };

@@ -335,9 +337,9 @@ in rec {

335337 commonName

336338 ];

337339 };

338− android = __android null;

339− ios = __ios null;

340− passthru = { inherit android ios packages overrides tools shellToolOverrides withHoogle staticFiles staticFilesImpure __closureCompilerOptimizationLevel processedStatic __ios __android; };

340+ android = __androidWithConfig (base + "/config");

341+ ios = __iosWithConfig (base + "/config");

342+ passthru = { inherit android ios packages overrides tools shellToolOverrides withHoogle staticFiles staticFilesImpure __closureCompilerOptimizationLevel processedStatic __iosWithConfig __androidWithConfig; };

341343 };

342344 in mkProject (projectDefinition args));

343345 serverOn = sys: version: serverExe

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

@@ -2,6 +2,6 @@

22 "owner": "reflex-frp",

33 "repo": "reflex-platform",

44 "branch": "develop",

5− "rev": "f86e8363ab1a5068b8419a61856e1aefea952bb0",

6− "sha256": "1f5qhrkj9h07j5xzw8s10x0r7b19vbh8j9z9lbzy23yxwmj78y7f"

5+ "rev": "d68ab80e3a92425d4bcbfa2da7c685aded550c16",

6+ "sha256": "0d5hc4v56pldy65rl0pmdzx2jylh8rjqqg5n0qb48039yy3pp8cq"

77}

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

@@ -17,6 +17,7 @@ library

1717 base

1818 , bytestring

1919 , containers

20+ , deepseq

2021 , directory

2122 , SHA

2223 , filepath

lib/asset/manifest/src/Obelisk/Asset/Gather.hs+5−2

@@ -1,10 +1,12 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE BangPatterns #-}

23-- | Functions for collecting up files to be processed by the asset pipeline

34module Obelisk.Asset.Gather

45 ( gatherHashedPaths

56 , toHashedPath

67 ) where

9+import Control.DeepSeq

810import Control.Monad (forM)

911import Data.Bits

1012import qualified Data.ByteString.Lazy as LBS

@@ -33,7 +35,7 @@ gatherHashedPaths root = go ""

3335 let relativePath = subdir </> sub

3436 isFile <- doesFileExist $ root </> relativePath

3537 if isFile

36− then do hashedRelativePath <- toHashedPath root relativePath

38+ then do !hashedRelativePath <- force <$> toHashedPath root relativePath

3739 return $ Map.singleton relativePath hashedRelativePath

3840 else go relativePath

3941

@@ -47,7 +49,8 @@ toHashedPath root relativePath = do

4749 contents <- LBS.readFile path

4850 let hashPrefix = T.unpack $ decodeUtf8 $ LBS.toStrict $ toNixBase32 $ bytestringDigest $ sha256 contents

4951 (dir, filename) = splitFileName relativePath

50− return $ normalise $ dir </> (hashPrefix <> "-" <> filename)

52+ !hashedRelativePath = force $ normalise $ dir </> (hashPrefix <> "-" <> filename)

53+ return hashedRelativePath

5154

5255-- | Convert a ByteString to base 32 in the way that Nix does

5356toNixBase32 :: LBS.ByteString -> LBS.ByteString

lib/backend/obelisk-backend.cabal+3

@@ -8,6 +8,7 @@ library

88 build-depends: base,

99 bytestring,

1010 categories,

11+ containers,

1112 cookie,

1213 data-default,

1314 dependent-sum,

@@ -15,6 +16,8 @@ library

1516 lens,

1617 mtl,

1718 obelisk-asset-serve-snap,

19+ obelisk-executable-config-backend,

20+ obelisk-executable-config-lookup,

1821 obelisk-frontend,

1922 obelisk-route,

2023 obelisk-snap-extras,

lib/backend/src/Obelisk/Backend.hs+52−21

@@ -11,6 +11,7 @@ module Obelisk.Backend

1111 ( Backend (..)

1212 -- * Re-exports

1313 , Default (def)

14+ , ComponentConfigs(..)

1415 , getPageName

1516 , getRouteWith

1617 , runSnapWithCommandLineArgs

@@ -19,6 +20,7 @@ module Obelisk.Backend

1920 , runBackend

2021 , staticRenderContentType

2122 , mkRouteToUrl

23+ , getComponentConfigs

2224 ) where

2325

2426import Prelude hiding (id, (.))

@@ -32,11 +34,15 @@ import Data.Default (Default (..))

3234import Data.Dependent.Sum

3335import Data.Functor.Sum

3436import Data.Functor.Identity

37+import Data.Map (Map)

38+import qualified Data.Map as Map

3539import Data.Monoid ((<>))

3640import Data.Text (Text)

3741import qualified Data.Text as T

3842import Data.Text.Encoding

3943import Obelisk.Asset.Serve.Snap (serveAsset)

44+import Obelisk.ExecutableConfig.Backend

45+import Obelisk.ExecutableConfig.Lookup

4046import Obelisk.Frontend

4147import Obelisk.Route

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

@@ -49,7 +55,14 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)

4955

5056data Backend backendRoute frontendRoute = Backend

5157 { _backend_routeEncoder :: Encoder (Either Text) Identity (R (Sum backendRoute (ObeliskRoute frontendRoute))) PageName

52− , _backend_run :: ((R backendRoute -> Snap ()) -> IO ()) -> IO ()

58+ , _backend_run :: ((R backendRoute -> BackendConfigsT Snap ()) -> BackendConfigsT IO ()) -> BackendConfigsT IO ()

59+ }

60+

61+-- | All the configs separated by which context they are accessible in. (Common

62+-- configs are present in both.)

63+data ComponentConfigs = ComponentConfigs

64+ { _componentConfigs_backend :: Map Text Text

65+ , _componentConfigs_frontend :: Map Text Text

5366 }

5467

5568-- | The static assets provided must contain a compiled GHCJS app that corresponds exactly to the Frontend provided

@@ -67,9 +80,10 @@ serveDefaultObeliskApp

6780 -> ([Text]

6881 -> m ())

6982 -> Frontend (R appRoute)

83+ -> Map Text Text

7084 -> R (ObeliskRoute appRoute)

7185 -> m ()

72−serveDefaultObeliskApp urlEnc serveStaticAsset frontend = serveObeliskApp urlEnc serveStaticAsset frontendApp

86+serveDefaultObeliskApp urlEnc serveStaticAsset frontend configs = serveObeliskApp urlEnc serveStaticAsset frontendApp configs

7387 where frontendApp = GhcjsApp

7488 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets

7589 , _ghcjsApp_value = frontend

@@ -94,16 +108,16 @@ defaultFrontendGhcjsAssets = StaticAssets

94108 , _staticAssets_unprocessed = "frontend.jsexe"

95109 }

96110

97−runSnapWithCommandLineArgs :: Snap () -> IO ()

111+runSnapWithCommandLineArgs :: MonadIO m => Snap () -> m ()

98112runSnapWithCommandLineArgs a = do

99113 -- Get the web server configuration from the command line

100− cmdLineConf <- commandLineConfig defaultConfig

114+ cmdLineConf <- liftIO $ commandLineConfig defaultConfig

101115 let httpConf = cmdLineConf

102116 { accessLog = Just $ ConfigIoLog BSC8.putStrLn

103117 , errorLog = Just $ ConfigIoLog BSC8.putStrLn

104118 }

105119 -- Start the web server

106− httpServe httpConf a

120+ liftIO $ httpServe httpConf a

107121

108122getPageName :: (MonadSnap m) => m PageName

109123getPageName = do

@@ -125,13 +139,14 @@ serveObeliskApp

125139 => (R appRoute -> Text)

126140 -> ([Text] -> m ())

127141 -> GhcjsApp (R appRoute)

142+ -> Map Text Text

128143 -> R (ObeliskRoute appRoute)

129144 -> m ()

130−serveObeliskApp urlEnc serveStaticAsset frontendApp = \case

131− ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

145+serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case

146+ ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

132147 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of

133148 ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments

134− ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp $ GhcjsAppRoute_Resource :/ pathSegments

149+ ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments

135150 ResourceRoute_JSaddleWarp :=> Identity _ -> do

136151 let msg = "Error: Obelisk.Backend received jsaddle request"

137152 liftIO $ putStrLn $ T.unpack msg

@@ -159,24 +174,30 @@ serveGhcjsApp

159174 :: (MonadSnap m, HasCookies m)

160175 => (R appRouteComponent -> Text)

161176 -> GhcjsApp (R appRouteComponent)

177+ -> Map Text Text

162178 -> R (GhcjsAppRoute appRouteComponent)

163179 -> m ()

164−serveGhcjsApp urlEnc app = \case

180+serveGhcjsApp urlEnc app config = \case

165181 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do

166182 modifyResponse $ setContentType staticRenderContentType

167− writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) $ _ghcjsApp_value app

183+ writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app

168184 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments

169185

170186runBackend :: Backend fullRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()

171187runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of

172188 Left e -> fail $ "backend error:\n" <> T.unpack e

173− Right validFullEncoder -> _backend_run backend $ \serveRoute -> do

174− runSnapWithCommandLineArgs $ do

175− getRouteWith validFullEncoder >>= \case

176− Identity r -> case r of

177− InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

178− InR obeliskRoute :=> Identity a ->

179− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend $ obeliskRoute :/ a

189+ Right validFullEncoder -> do

190+ configs <- getComponentConfigs

191+ runBackendConfigsT (_componentConfigs_backend configs) $

192+ _backend_run backend $ \serveRoute -> do

193+ runSnapWithCommandLineArgs $ do

194+ getRouteWith validFullEncoder >>= \case

195+ Identity r -> case r of

196+ InL backendRoute :=> Identity a ->

197+ runBackendConfigsT (_componentConfigs_backend configs) $

198+ serveRoute $ backendRoute :/ a

199+ InR obeliskRoute :=> Identity a ->

200+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend (_componentConfigs_frontend configs) $ obeliskRoute :/ a

180201

181202mkRouteToUrl :: Encoder Identity parse (R (Sum f (ObeliskRoute r))) PageName -> R r -> Text

182203mkRouteToUrl validFullEncoder =

@@ -187,15 +208,25 @@ renderGhcjsFrontend

187208 :: (MonadSnap m, HasCookies m)

188209 => (route -> Text)

189210 -> route

211+ -> Map Text Text

190212 -> Frontend route

191213 -> m ByteString

192−renderGhcjsFrontend urlEnc route f = do

214+renderGhcjsFrontend urlEnc route configs f = do

193215 let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "ghcjs/all.js") blank

194216 ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank

195217 cookies <- askCookies

196− renderFrontendHtml cookies urlEnc route

197− (_frontend_head f >> ghcjsPreload)

198− (_frontend_body f >> ghcjsScript)

218+ renderFrontendHtml configs cookies urlEnc route f ghcjsPreload ghcjsScript

199219

200220instance HasCookies Snap where

201221 askCookies = map (\c -> (cookieName c, cookieValue c)) <$> getsRequest rqCookies

222+

223+getComponentConfigs :: IO ComponentConfigs

224+getComponentConfigs = do

225+ allConfigs <- getConfigs

226+ return $ ComponentConfigs

227+ { _componentConfigs_backend =

228+ Map.filterWithKey (\k _ -> isMemberOf k ["common", "backend"]) allConfigs

229+ , _componentConfigs_frontend =

230+ Map.filterWithKey (\k _ -> isMemberOf k ["common", "frontend"]) allConfigs

231+ }

232+ where isMemberOf k dirs = or $ map (\dir -> ("config/" <> dir) `T.isPrefixOf` k) dirs

lib/command/src/Obelisk/Command.hs+27−5

@@ -92,6 +92,7 @@ data ObCommand

9292 | ObCommand_Thunk ThunkCommand

9393 | ObCommand_Repl

9494 | ObCommand_Watch

95+ | ObCommand_Shell ShellOpts

9596 | ObCommand_Internal ObInternal

9697 deriving Show

9798

@@ -103,7 +104,7 @@ data ObInternal

103104inNixShell' :: MonadObelisk m => StaticPtr (ObeliskT IO ()) -> m ()

104105inNixShell' p = withProjectRoot "." $ \root -> do

105106 cmd <- liftIO $ unwords <$> mkCmd -- TODO: shell escape instead of unwords

106− projectShell root False "ghc" cmd

107+ projectShell root False "ghc" (Just cmd)

107108 where

108109 mkCmd = do

109110 argsCfg <- getArgsConfig

@@ -127,6 +128,7 @@ obCommand cfg = hsubparser

127128 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"

128129 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"

129130 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"

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

130132 ])

131133 <|> subparser

132134 (mconcat

@@ -211,16 +213,34 @@ thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgumen

211213data ThunkCommand

212214 = ThunkCommand_Update [FilePath] (Maybe String)

213215 | ThunkCommand_Unpack [FilePath]

214− | ThunkCommand_Pack [FilePath]

216+ | ThunkCommand_Pack [FilePath] Bool

215217 deriving Show

216218

219+forceFlag :: Parser Bool

220+forceFlag = switch $ long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care."

221+

217222thunkCommand :: Parser ThunkCommand

218223thunkCommand = hsubparser $ mconcat

219224 [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"

220225 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"

221− , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

226+ , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> forceFlag) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

222227 ]

223228

229+data ShellOpts

230+ = ShellOpts

231+ { _shellOpts_shell :: String

232+ , _shellOpts_command :: Maybe String

233+ }

234+ deriving Show

235+

236+shellOpts :: Parser ShellOpts

237+shellOpts = ShellOpts

238+ <$> ( flag' "ghc" (long "ghc" <> help "Enter a shell environment having ghc (default)")

239+ <|> flag "ghc" "ghcjs" (long "ghcjs" <> help "Enter a shell having ghcjs rather than ghc")

240+ <|> strOption (short 'A' <> long "argument" <> metavar "NIXARG" <> help "Use the environment specified by the given nix argument of `shells'")

241+ )

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

243+

224244parserPrefs :: ParserPrefs

225245parserPrefs = defaultPrefs

226246 { prefShowHelpOnEmpty = True

@@ -325,7 +345,7 @@ ob = \case

325345 Right (ThunkData_Packed ptr) -> return ptr

326346 Right (ThunkData_Checkout (Just ptr)) -> return ptr

327347 Right (ThunkData_Checkout Nothing) ->

328− getThunkPtr' False root

348+ getThunkPtr False root

329349 let sshKeyPath = _deployInitOpts_sshKey deployOpts

330350 hostname = _deployInitOpts_hostname deployOpts

331351 route = _deployInitOpts_route deployOpts

@@ -344,9 +364,11 @@ ob = \case

344364 ObCommand_Thunk tc -> case tc of

345365 ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks

346366 ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks

347− ThunkCommand_Pack thunks -> forM_ thunks packThunk

367+ ThunkCommand_Pack thunks force -> forM_ thunks (packThunk force)

348368 ObCommand_Repl -> runRepl

349369 ObCommand_Watch -> inNixShell' $ static runWatch

370+ ObCommand_Shell so -> withProjectRoot "." $ \root ->

371+ projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

350372 ObCommand_Internal icmd -> case icmd of

351373 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case

352374 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

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

@@ -108,7 +108,7 @@ deployPush deployPath getNixBuilders = do

108108 Right (ThunkData_Packed ptr) -> return ptr

109109 Right (ThunkData_Checkout _) -> do

110110 checkGitCleanStatus srcPath True >>= \case

111− True -> packThunk srcPath

111+ True -> packThunk False srcPath

112112 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."

113113 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)

114114 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr

@@ -234,7 +234,7 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do

234234 [ "with (import ", srcDir, " {});"

235235 , "android.frontend.override (drv: { "

236236 , "releaseKey = (if builtins.isNull drv.releaseKey then {} else drv.releaseKey) // " <> releaseKey <> "; "

237− , "staticSrc = (passthru.__android ", configDir, ").frontend.staticSrc;"

237+ , "staticSrc = (passthru.__androidWithConfig ", configDir, ").frontend.staticSrc;"

238238 , "})"

239239 ]

240240 return $ Target

@@ -245,7 +245,7 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do

245245 IOS -> do

246246 let expr = mconcat

247247 [ "with (import ", srcDir, " {});"

248− , "ios.frontend.override (_: { staticSrc = (passthru.__ios ", configDir, ").frontend.staticSrc; })"

248+ , "ios.frontend.override (_: { staticSrc = (passthru.__iosWithConfig ", configDir, ").frontend.staticSrc; })"

249249 ]

250250 return $ Target

251251 { _target_path = Nothing

lib/command/src/Obelisk/Command/Project.hs+6−5

@@ -196,20 +196,21 @@ isWritableOnlyBy s uid = fileOwner s == uid && fileMode s .&. 0o22 == 0

196196-- | Run a command in the given shell for the current project

197197inProjectShell :: MonadObelisk m => String -> String -> m ()

198198inProjectShell shellName command = withProjectRoot "." $ \root ->

199− projectShell root True shellName command

199+ projectShell root True shellName (Just command)

200200

201201inImpureProjectShell :: MonadObelisk m => String -> String -> m ()

202202inImpureProjectShell shellName command = withProjectRoot "." $ \root ->

203− projectShell root False shellName command

203+ projectShell root False shellName (Just command)

204204

205−projectShell :: MonadObelisk m => FilePath -> Bool -> String -> String -> m ()

205+projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

206206projectShell root isPure shellName command = do

207207 (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCtlc $ setCwd (Just root) $ proc "nix-shell" $

208208 [ "--pure" | isPure ] <>

209209 [ "-A"

210210 , "shells." <> shellName

211− , "--run", command

212− ]

211+ ] <> case command of

212+ Nothing -> []

213+ Just c -> ["--run", c]

213214 void $ liftIO $ waitForProcess ph

214215

215216setCtlc :: CreateProcess -> CreateProcess

lib/command/src/Obelisk/Command/Thunk.hs+7−12

@@ -26,7 +26,6 @@ module Obelisk.Command.Thunk

2626 , readThunk

2727 , updateThunk

2828 , getThunkPtr

29− , getThunkPtr'

3029 , parseGitUri

3130 , uriThunkPtr

3231 ) where

@@ -573,7 +572,7 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

573572 return tmpThunk

574573 Right _ -> failWith $ "Thunk is not packed"

575574 updateThunkFromTmp p' = do

576− _ <- packThunk' True p'

575+ _ <- packThunk' True False p'

577576 callProcessAndLogOutput (Notice, Error) $

578577 proc "cp" ["-r", "-T", p', p]

579578

@@ -622,28 +621,24 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

622621 callProcessAndLogOutput (Notice, Error) $

623622 proc "mv" ["-T", tmpRepo, thunkDir]

624623

625−--TODO: add force mode to pack even if changes are present

626624--TODO: add a rollback mode to pack to the original thunk

627−packThunk :: MonadObelisk m => FilePath -> m ThunkPtr

625+packThunk :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr

628626packThunk = packThunk' False

629627

630−packThunk' :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr

631−packThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

628+packThunk' :: MonadObelisk m => Bool -> Bool -> FilePath -> m ThunkPtr

629+packThunk' noTrail force thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

632630 Left err -> failWith $ T.pack $ "thunk pack: " <> show err

633631 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

634632 Right (ThunkData_Checkout _) -> do

635633 withSpinner' ("Packing thunk " <> T.pack thunkDir)

636634 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

637− thunkPtr <- getThunkPtr thunkDir

635+ thunkPtr <- getThunkPtr (not force) thunkDir

638636 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]

639637 liftIO $ createThunk thunkDir thunkPtr

640638 pure thunkPtr

641639

642−getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr

643−getThunkPtr = getThunkPtr' True

644−

645−getThunkPtr' :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

646−getThunkPtr' checkClean thunkDir = do

640+getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

641+getThunkPtr checkClean thunkDir = do

647642 when checkClean $ ensureCleanGitRepo thunkDir True $

648643 "thunk pack: thunk checkout contains unsaved modifications"

649644

lib/executable-config/backend/obelisk-executable-config-backend.cabalnew file+20

@@ -0,0 +1,20 @@

1+name: obelisk-executable-config-backend

2+version: 0.1

3+cabal-version: >= 1.2

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base,

9+ containers,

10+ monad-control,

11+ mtl,

12+ primitive,

13+ ref-tf,

14+ snap-core,

15+ text,

16+ transformers,

17+ transformers-base

18+ exposed-modules:

19+ Obelisk.ExecutableConfig.Backend

20+ ghc-options: -Wall

lib/executable-config/backend/src/Obelisk/ExecutableConfig/Backend.hsnew file+77

@@ -0,0 +1,77 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DefaultSignatures #-}

4+{-# LANGUAGE DeriveFunctor #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

9+{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE RankNTypes #-}

11+{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE UndecidableInstances #-}

13+module Obelisk.ExecutableConfig.Backend

14+ ( HasBackendConfigs(..)

15+ , BackendConfigsT

16+ , runBackendConfigsT

17+ , mapBackendConfigsT

18+ ) where

19+

20+import Control.Applicative

21+import Control.Monad

22+import Control.Monad.Base

23+import Control.Monad.Fix

24+import Control.Monad.Primitive

25+import Control.Monad.Ref

26+import Control.Monad.IO.Class

27+import Control.Monad.Trans.Class

28+import Control.Monad.Trans.Control

29+import Control.Monad.Trans.Reader

30+import Data.Map (Map)

31+import qualified Data.Map as Map

32+import Data.Text (Text)

33+import Snap.Core (MonadSnap)

34+

35+class Monad m => HasBackendConfigs m where

36+ getBackendConfig :: Text -> m (Maybe Text)

37+ default getBackendConfig :: (HasBackendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

38+ getBackendConfig = lift . getBackendConfig

39+ getCommonConfig :: Text -> m (Maybe Text)

40+ default getCommonConfig :: (HasBackendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

41+ getCommonConfig = lift . getCommonConfig

42+

43+newtype BackendConfigsT m a = BackendConfigsT { unBackendConfigsT :: ReaderT (Map Text Text) m a }

44+ deriving

45+ ( Functor

46+ , Applicative

47+ , Monad

48+ , MonadPlus

49+ , Alternative

50+ , MonadFix

51+ , MonadIO

52+ , MonadBase m'

53+ , MonadBaseControl m'

54+ , MonadRef

55+ , MonadTrans

56+ , MonadSnap

57+ )

58+

59+instance PrimMonad m => PrimMonad (BackendConfigsT m) where

60+ type PrimState (BackendConfigsT m) = PrimState m

61+ primitive = lift . primitive

62+

63+runBackendConfigsT

64+ :: Map Text Text

65+ -> BackendConfigsT m a

66+ -> m a

67+runBackendConfigsT cs child = runReaderT (unBackendConfigsT child) cs

68+

69+instance Monad m => HasBackendConfigs (BackendConfigsT m) where

70+ getBackendConfig k = BackendConfigsT $ Map.lookup ("config/backend/" <> k) <$> ask

71+ getCommonConfig k = BackendConfigsT $ Map.lookup ("config/common/" <> k) <$> ask

72+

73+mapBackendConfigsT

74+ :: (forall x. m x -> n x)

75+ -> BackendConfigsT m a

76+ -> BackendConfigsT n a

77+mapBackendConfigsT f (BackendConfigsT x) = BackendConfigsT $ mapReaderT f x

lib/executable-config/default.nix+6−1

@@ -16,9 +16,14 @@ let injectConfig = config: assets: nixpkgs.runCommand "inject-config" {} (''

1616 exit 1

1717 fi

1818 cp -a "${config}"/* "$out/config"

19+ (cd $out && find config -type f -print0 >config.files)

1920 '');

2021in with nixpkgs.haskell.lib; {

21− haskellPackage = self: self.callPackage (filterGitSource ./lookup) {};

22+ haskellOverlay = self: super: {

23+ obelisk-executable-config-backend = self.callCabal2nix "obelisk-executable-config-backend" (filterGitSource ./backend) {};

24+ obelisk-executable-config-frontend = self.callCabal2nix "obelisk-executable-config-frontend" (filterGitSource ./frontend) {};

25+ obelisk-executable-config-lookup = self.callPackage (filterGitSource ./lookup) {};

26+ };

2227 platforms = {

2328 android = {

2429 # Inject the given config directory into an android assets folder

lib/executable-config/frontend/obelisk-executable-config-frontend.cabalnew file+21

@@ -0,0 +1,21 @@

1+name: obelisk-executable-config-frontend

2+version: 0.1

3+cabal-version: >= 1.2

4+build-type: Simple

6+library

7+ hs-source-dirs: src

8+ build-depends: base,

9+ containers,

10+ ghcjs-dom,

11+ jsaddle,

12+ mtl,

13+ primitive,

14+ ref-tf,

15+ reflex,

16+ reflex-dom-core,

17+ text,

18+ transformers

19+ exposed-modules:

20+ Obelisk.ExecutableConfig.Frontend

21+ ghc-options: -Wall

lib/executable-config/frontend/src/Obelisk/ExecutableConfig/Frontend.hsnew file+115

@@ -0,0 +1,115 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DefaultSignatures #-}

4+{-# LANGUAGE DeriveFunctor #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

9+{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE RankNTypes #-}

11+{-# LANGUAGE TypeFamilies #-}

12+{-# LANGUAGE UndecidableInstances #-}

13+module Obelisk.ExecutableConfig.Frontend

14+ ( HasFrontendConfigs(..)

15+ , FrontendConfigsT

16+ , runFrontendConfigsT

17+ , mapFrontendConfigsT

18+ ) where

19+

20+import Control.Monad.Fix

21+import Control.Monad.Primitive

22+import Control.Monad.Ref

23+import Control.Monad.IO.Class

24+import Control.Monad.Trans.Class

25+import Control.Monad.Trans.Reader

26+import Data.Map (Map)

27+import qualified Data.Map as Map

28+import Data.Text (Text)

29+import Reflex

30+import Reflex.Host.Class

31+import Reflex.Dom.Core

32+#ifndef ghcjs_HOST_OS

33+import GHCJS.DOM.Types (MonadJSM)

34+#endif

35+

36+class Monad m => HasFrontendConfigs m where

37+ getFrontendConfig :: Text -> m (Maybe Text)

38+ default getFrontendConfig :: (HasFrontendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

39+ getFrontendConfig = lift . getFrontendConfig

40+ getCommonConfig :: Text -> m (Maybe Text)

41+ default getCommonConfig :: (HasFrontendConfigs m', m ~ t m', MonadTrans t) => Text -> m (Maybe Text)

42+ getCommonConfig = lift . getCommonConfig

43+

44+instance HasFrontendConfigs m => HasFrontendConfigs (BehaviorWriterT t w m)

45+instance HasFrontendConfigs m => HasFrontendConfigs (DynamicWriterT t w m)

46+instance HasFrontendConfigs m => HasFrontendConfigs (EventWriterT t w m)

47+instance HasFrontendConfigs m => HasFrontendConfigs (PostBuildT t m)

48+instance HasFrontendConfigs m => HasFrontendConfigs (QueryT t q m)

49+instance HasFrontendConfigs m => HasFrontendConfigs (ReaderT r m)

50+instance HasFrontendConfigs m => HasFrontendConfigs (RequesterT t request response m)

51+instance HasFrontendConfigs m => HasFrontendConfigs (StaticDomBuilderT t m)

52+instance HasFrontendConfigs m => HasFrontendConfigs (TriggerEventT t m)

53+

54+newtype FrontendConfigsT m a = FrontendConfigsT { unFrontendConfigsT :: ReaderT (Map Text Text) m a }

55+ deriving

56+ ( Functor

57+ , Applicative

58+ , DomBuilder t

59+ , Monad

60+ , MonadFix

61+ , MonadHold t

62+ , MonadIO

63+#ifndef ghcjs_HOST_OS

64+ , MonadJSM

65+#endif

66+ , MonadRef

67+ , MonadReflexCreateTrigger t

68+ , MonadSample t

69+ , MonadTrans

70+ , NotReady t

71+ , PostBuild t

72+ , TriggerEvent t

73+ , HasDocument

74+ , DomRenderHook t

75+ , HasJSContext

76+ , HasJS js

77+ )

78+

79+instance PerformEvent t m => PerformEvent t (FrontendConfigsT m) where

80+ type Performable (FrontendConfigsT m) = FrontendConfigsT (Performable m)

81+ performEvent e = FrontendConfigsT $ ReaderT $ \configs ->

82+ performEvent $ runFrontendConfigsT configs <$> e

83+ performEvent_ e = FrontendConfigsT $ ReaderT $ \configs ->

84+ performEvent_ $ runFrontendConfigsT configs <$> e

85+

86+instance Adjustable t m => Adjustable t (FrontendConfigsT m) where

87+ runWithReplace a e = FrontendConfigsT $ runWithReplace (unFrontendConfigsT a) (unFrontendConfigsT <$> e)

88+ traverseDMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

89+ traverseIntMapWithKeyWithAdjust f m e = FrontendConfigsT $ traverseIntMapWithKeyWithAdjust (\k v -> unFrontendConfigsT $ f k v) m e

90+ traverseDMapWithKeyWithAdjustWithMove f m e = FrontendConfigsT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unFrontendConfigsT $ f k v) m e

91+

92+instance Prerender js t m => Prerender js t (FrontendConfigsT m) where

93+ type Client (FrontendConfigsT m) = FrontendConfigsT (Client m)

94+ prerender server client = FrontendConfigsT $ ReaderT $ \configs ->

95+ prerender (runFrontendConfigsT configs server) (runFrontendConfigsT configs client)

96+

97+instance PrimMonad m => PrimMonad (FrontendConfigsT m) where

98+ type PrimState (FrontendConfigsT m) = PrimState m

99+ primitive = lift . primitive

100+

101+runFrontendConfigsT

102+ :: Map Text Text

103+ -> FrontendConfigsT m a

104+ -> m a

105+runFrontendConfigsT cs child = runReaderT (unFrontendConfigsT child) cs

106+

107+instance Monad m => HasFrontendConfigs (FrontendConfigsT m) where

108+ getFrontendConfig k = FrontendConfigsT $ Map.lookup ("config/frontend/" <> k) <$> ask

109+ getCommonConfig k = FrontendConfigsT $ Map.lookup ("config/common/" <> k) <$> ask

110+

111+mapFrontendConfigsT

112+ :: (forall x. m x -> n x)

113+ -> FrontendConfigsT m a

114+ -> FrontendConfigsT n a

115+mapFrontendConfigsT f (FrontendConfigsT x) = FrontendConfigsT $ mapReaderT f x

lib/executable-config/inject/obelisk-executable-config-inject.cabal+1−3

@@ -8,9 +8,7 @@ library

99 build-depends:

1010 base,

11− bytestring,

12− directory,

13− filepath,

11+ containers,

1412 reflex-dom-core,

1513 text

1614

lib/executable-config/inject/src/Obelisk/ExecutableConfig/Inject.hs+8−37

@@ -2,50 +2,21 @@

22module Obelisk.ExecutableConfig.Inject where

44import Control.Monad (mapM_)

5−import Control.Monad.IO.Class (MonadIO, liftIO)

5+import Control.Monad.IO.Class (MonadIO)

6+import Data.Map (Map)

7+import qualified Data.Map as Map

68import Data.Semigroup ((<>))

7−import Data.ByteString (ByteString)

89import Data.Text (Text)

9−import qualified Data.Text as T

10−import qualified Data.Text.IO as T

1110import Reflex.Dom.Core hiding (value)

12−import System.Directory

13−import System.FilePath ((</>))

14−

15−-- | Produces a @<script>@ tag containing the contents of the config item,

16−-- rendered as a 'ByteString'.

17−inject :: FilePath -> IO ByteString

18−inject key = do

19− value <- T.readFile key

20− fmap snd $ renderStatic $ injectPure (T.pack key) value

2111

2212-- | Produces a @<script>@ tag with an @id@ attribute containing the key and

2313-- whose value is the provided configuration

2414injectPure :: DomBuilder t m => Text -> Text -> m ()

2515injectPure key value =

26− let attrs = ("type" =: "text/plain" <> "id" =: ("config-" <> key))

16+ let attrs = ("type" =: "text/plain" <> "data-obelisk-executable-config-inject-key" =: key)

2717 in elAttr "script" attrs $ text value

2818

29−-- | Scans the "common" and "frontend" configuration folders and produces

30−-- injectable @<script>@ tags containing the configuration keys (filepaths) and

31−-- values.

32−injectExecutableConfigs :: (MonadIO m, DomBuilder t m) => m ()

33−injectExecutableConfigs = do

34− cfgC <- getConfigs "config/common"

35− cfgF <- getConfigs "config/frontend"

36− mapM_ (uncurry injectPure) (cfgC <> cfgF)

37−

38−getConfigs :: MonadIO m => FilePath -> m [(Text, Text)]

39−getConfigs fp = liftIO $ do

40− dir <- doesDirectoryExist fp

41− if dir

42− then do

43− ps <- listDirectory fp

44− fmap concat $ mapM (\p -> getConfigs $ fp </> p) ps

45− else do

46− file <- doesFileExist fp

47− if file

48− then do

49− f <- T.readFile fp

50− return [(T.pack fp, f)]

51− else return []

19+-- | Produces injectable @<script>@ tags containing the configuration keys

20+-- (filepaths) and values.

21+injectExecutableConfigs :: (MonadIO m, DomBuilder t m) => Map Text Text -> m ()

22+injectExecutableConfigs = mapM_ (uncurry injectPure) . Map.toList

lib/executable-config/lookup/default.nix+1−1

@@ -6,7 +6,7 @@ let isAndroid = hostPlatform.libc == "bionic";

66 isIOS = hostPlatform.isDarwin && hostPlatform.isAarch64;

77 isGhcjs = ghc.isGhcjs or false;

88in mkDerivation {

9− pname = "obelisk-executable-config";

9+ pname = "obelisk-executable-config-lookup";

1010 version = "0.1";

1111 src = ./.;

1212 libraryHaskellDepends = [

lib/executable-config/lookup/obelisk-executable-config.cabal → lib/executable-config/lookup/obelisk-executable-config-lookup.cabalrenamed+11−4

@@ -1,13 +1,15 @@

1−name: obelisk-executable-config

1+name: obelisk-executable-config-lookup

22version: 0.1.1

33cabal-version: >= 1.2

44build-type: Simple

66library

7− exposed-modules: Obelisk.ExecutableConfig

7+ exposed-modules: Obelisk.ExecutableConfig.Lookup

88 if os(ios)

9− hs-source-dirs: src-ios

9+ hs-source-dirs: src-ios, src-directory

10+ other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

1011 build-depends: jsaddle-wkwebview

12+ build-depends: directory

1113 else

1214 if os(linux-android)

1315 hs-source-dirs: src-android

@@ -20,11 +22,16 @@ library

2022 hs-source-dirs: src-ghcjs

2123 build-depends: ghcjs-dom

2224 else

23− hs-source-dirs: src

25+ hs-source-dirs: src, src-directory

26+ other-modules: Obelisk.ExecutableConfig.Internal.ConfigDirectory

27+ build-depends: directory

2428

2529 build-depends:

2630 base,

2731 bytestring,

32+ containers,

2833 filepath,

2934 text,

3035 transformers

36+

37+ ghc-options: -Wall

lib/executable-config/lookup/src-android/Obelisk/ExecutableConfig.hsdeleted−27

@@ -1,27 +0,0 @@

1−module Obelisk.ExecutableConfig (get) where

2−

3−import Control.Exception (bracket)

4−import qualified Data.ByteString as BS

5−import Data.Text (Text)

6−import qualified Data.Text as T

7−import qualified Data.Text.Encoding as T

8−import Foreign.C.String (withCString)

9−import Foreign.Ptr (nullPtr)

10−import System.FilePath.Posix ((</>))

11−

12−import Obelisk.ExecutableConfig.Internal.AssetManager

13−

14−get :: Text -> IO (Maybe Text)

15−get name = bracket getAssets freeAssetManager $ \mgrObj -> do

16− mgr <- assetManagerFromJava mgrObj

17− let open = do

18− a <- withCString (T.unpack name) $ \fn ->

19− assetManager_open mgr fn 3

20− return $ if unAAsset a == nullPtr

21− then Nothing

22− else Just a

23− close = mapM_ asset_close

24− bracket open close $ mapM $ \asset -> do

25− b <- asset_getBuffer asset

26− l <- asset_getLength asset

27− fmap T.decodeUtf8 $ BS.packCStringLen (b, fromIntegral l)

lib/executable-config/lookup/src-android/Obelisk/ExecutableConfig/Lookup.hsnew file+56

@@ -0,0 +1,56 @@

1+{-# LANGUAGE LambdaCase #-}

2+module Obelisk.ExecutableConfig.Lookup where

4+import Control.Exception (bracket)

5+import Control.Monad (forM)

6+import qualified Data.ByteString as BS

7+import Data.Map (Map)

8+import qualified Data.Map as Map

9+import Data.Text (Text)

10+import qualified Data.Text.Encoding as T

11+import Foreign.C.String (withCString)

12+import Foreign.Ptr (nullPtr)

13+

14+import Obelisk.ExecutableConfig.Internal.AssetManager

15+

16+getFromMgr :: AAssetManager -> BS.ByteString -> IO (Maybe Text)

17+getFromMgr mgr name = do

18+ let open = do

19+ a <- BS.useAsCString name $ \fn ->

20+ assetManager_open mgr fn 3

21+ return $ if unAAsset a == nullPtr

22+ then Nothing

23+ else Just a

24+ close = mapM_ asset_close

25+ bracket open close $ mapM $ \asset -> do

26+ b <- asset_getBuffer asset

27+ l <- asset_getLength asset

28+ fmap T.decodeUtf8 $ BS.packCStringLen (b, fromIntegral l)

29+

30+getConfigs :: IO (Map Text Text)

31+getConfigs = bracket getAssets freeAssetManager $ \mgrObj -> do

32+ mgr <- assetManagerFromJava mgrObj

33+ let openDir = do

34+ d <- withCString "config.files" $ \fn ->

35+ assetManager_open mgr fn 3

36+ return $ if unAAsset d == nullPtr

37+ then Nothing

38+ else Just d

39+ closeDir = mapM_ asset_close

40+ configPaths <- bracket openDir closeDir $ \case

41+ Just asset -> do

42+ b <- asset_getBuffer asset

43+ l <- asset_getLength asset

44+ lines0 <$> BS.packCStringLen (b, fromIntegral l)

45+ Nothing -> error "could not open configuration manifest 'config.files'"

46+ fmap Map.fromList $ forM configPaths $ \fp ->

47+ getFromMgr mgr fp >>= \case

48+ Just v -> return (T.decodeUtf8 fp, v)

49+ Nothing -> error $ "Config present in config.files but not in assets: " <> show fp

50+

51+lines0 :: BS.ByteString -> [BS.ByteString]

52+lines0 ps

53+ | BS.null ps = []

54+ | otherwise = case BS.elemIndex 0 ps of

55+ Nothing -> [ps]

56+ Just n -> BS.take n ps : lines0 (BS.drop (n+1) ps)

lib/executable-config/lookup/src-directory/Obelisk/ExecutableConfig/Internal/ConfigDirectory.hsnew file+24

@@ -0,0 +1,24 @@

1+module Obelisk.ExecutableConfig.Internal.ConfigDirectory where

3+import Data.Map (Map)

4+import qualified Data.Map as Map

5+import Data.Text (Text)

6+import Data.Text as T

7+import Data.Text.IO as T

8+import System.Directory

9+import System.FilePath.Posix ((</>))

10+

11+getConfigsFromDirectory :: FilePath -> FilePath -> IO (Map Text Text)

12+getConfigsFromDirectory base fp = do

13+ dir <- doesDirectoryExist (base </> fp)

14+ if dir

15+ then do

16+ ps <- listDirectory (base </> fp)

17+ fmap mconcat $ mapM (\p -> getConfigsFromDirectory base $ fp </> p) ps

18+ else do

19+ file <- doesFileExist (base </> fp)

20+ if file

21+ then do

22+ f <- T.readFile (base </> fp)

23+ return $ Map.singleton (T.pack fp) f

24+ else return mempty

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig.hsdeleted−17

@@ -1,17 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Obelisk.ExecutableConfig where

3−

4−import Control.Monad.Trans.Maybe

5−import Data.Semigroup ((<>))

6−import Data.Text (Text)

7−import GHCJS.DOM

8−import GHCJS.DOM.Document

9−import GHCJS.DOM.Element

10−import GHCJS.DOM.NonElementParentNode

11−

12−get :: Text -> IO (Maybe Text)

13−get item = runMaybeT $ do

14− doc <- MaybeT currentDocument

15− e <- MaybeT $ getElementById doc $ "config-" <> item

16− getInnerHTML e

17−

lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Lookup.hsnew file+36

@@ -0,0 +1,36 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Obelisk.ExecutableConfig.Lookup where

5+import Data.Map (Map)

6+import qualified Data.Map as Map

7+import Data.Maybe (catMaybes)

8+import Data.Text (Text)

9+import Data.Traversable (for)

10+import GHCJS.DOM

11+import GHCJS.DOM.Document (getHead)

12+import GHCJS.DOM.DOMStringMap (get)

13+import GHCJS.DOM.Element (getInnerHTML)

14+import GHCJS.DOM.HTMLElement (HTMLElement(HTMLElement), getDataset)

15+import GHCJS.DOM.NodeList (item, getLength)

16+import GHCJS.DOM.ParentNode (querySelectorAll)

17+import GHCJS.DOM.Types (Node(Node), castTo)

18+

19+getConfigs :: IO (Map Text Text)

20+getConfigs = do

21+ Just doc <- currentDocument

22+ Just hd <- getHead doc

23+ nodes <- collToList =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)

24+ fmap Map.fromList $ for nodes $ \node -> do

25+ e <- castTo HTMLElement node >>= \case

26+ Nothing -> error "Found node with data attribute obelisk-executable-config-inject-key that is not an HTMLElement."

27+ Just htmlE -> return htmlE

28+ dataset <- getDataset e

29+ (,)

30+ <$> get dataset ("obelisk-executable-config-inject-key" :: Text)

31+ <*> getInnerHTML e

32+ where

33+ collToList es = do

34+ len <- getLength es

35+ list <- traverse (item es) [0..len-1]

36+ pure $ catMaybes list

lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig.hsdeleted−22

@@ -1,22 +0,0 @@

1−module Obelisk.ExecutableConfig (get) where

2−

3−import Control.Exception

4−import Control.Monad

5−import Control.Monad.Trans.Maybe

6−import Data.ByteString as BS

7−import Data.Text (Text)

8−import qualified Data.Text as T

9−import qualified Data.Text.IO as T

10−import qualified Data.Text.Encoding as T

11−import Language.Javascript.JSaddle.WKWebView

12−import System.FilePath.Posix ((</>))

13−import System.IO.Error

14−

15−get :: Text -> IO (Maybe Text)

16−get name = fmap join $ mainBundleResourcePath >>= \mp -> forM mp $ \p ->

17− catchDoesNotExist $ T.readFile $ T.unpack (T.decodeUtf8 p) </> T.unpack name

18−

19−catchDoesNotExist :: IO a -> IO (Maybe a)

20−catchDoesNotExist f = catchJust doesNotExist (Just <$> f) $ const $ return Nothing

21− where

22− doesNotExist e = if isDoesNotExistError e then Just () else Nothing

lib/executable-config/lookup/src-ios/Obelisk/ExecutableConfig/Lookup.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE LambdaCase #-}

2+module Obelisk.ExecutableConfig.Lookup where

4+import Data.Map (Map)

5+import Data.Text (Text)

6+import qualified Data.Text as T

7+import qualified Data.Text.Encoding as T

8+import Language.Javascript.JSaddle.WKWebView

10+import Obelisk.ExecutableConfig.Internal.ConfigDirectory

11+

12+getConfigs :: IO (Map Text Text)

13+getConfigs = mainBundleResourcePath >>= \case

14+ Nothing -> error "Could not get bundle resource path."

15+ Just p -> getConfigsFromDirectory (T.unpack (T.decodeUtf8 p)) "config"

lib/executable-config/lookup/src/Obelisk/ExecutableConfig.hsdeleted−13

@@ -1,13 +0,0 @@

1−module Obelisk.ExecutableConfig (get) where

2−

3−import Control.Exception

4−import Data.Text (Text)

5−import Data.Text as T

6−import Data.Text.IO as T

7−import System.FilePath.Posix ((</>))

8−import System.IO.Error

9−

10−get :: Text -> IO (Maybe Text)

11−get path = do

12− let doesNotExist = \e -> if isDoesNotExistError e then Just () else Nothing

13− catchJust doesNotExist (fmap Just $ T.readFile $ T.unpack path) (\_ -> pure Nothing)

lib/executable-config/lookup/src/Obelisk/ExecutableConfig/Lookup.hsnew file+9

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

1+module Obelisk.ExecutableConfig.Lookup where

3+import Data.Map (Map)

4+import Data.Text (Text)

6+import Obelisk.ExecutableConfig.Internal.ConfigDirectory

8+getConfigs :: IO (Map Text Text)

9+getConfigs = getConfigsFromDirectory "." "config"

lib/frontend/obelisk-frontend.cabal+3

@@ -7,13 +7,16 @@ library

77 hs-source-dirs: src

88 build-depends: base,

99 bytestring,

10+ containers,

1011 cookie,

1112 dependent-sum,

1213 ghcjs-dom,

1314 jsaddle,

1415 lens,

1516 mtl,

17+ obelisk-executable-config-frontend,

1618 obelisk-executable-config-inject,

19+ obelisk-executable-config-lookup,

1720 obelisk-route,

1821 primitive,

1922 ref-tf,

lib/frontend/src/Obelisk/Frontend.hs+64−15

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

11{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE CPP #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE FlexibleInstances #-}

45{-# LANGUAGE LambdaCase #-}

@@ -14,7 +15,9 @@ module Obelisk.Frontend

1415 ( ObeliskWidget

1516 , Frontend (..)

1617 , runFrontend

18+ , runFrontendWithConfigs

1719 , renderFrontendHtml

20+ , removeHTMLConfigs

1821 , module Obelisk.Frontend.Cookie

1922 ) where

2023

@@ -27,16 +30,27 @@ import Control.Monad.IO.Class

2730import Control.Monad.Primitive

2831import Control.Monad.Reader

2932import Control.Monad.Ref

33+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

3034import Data.ByteString (ByteString)

35+import Data.Foldable (for_)

3136import Data.Functor.Sum

37+import Data.Map (Map)

38+import Data.Maybe (catMaybes)

3239import Data.Monoid ((<>))

3340import Data.Text (Text)

41+import GHCJS.DOM (currentDocument)

42+import GHCJS.DOM.Document (getHead)

43+import GHCJS.DOM.Node (removeChild_)

44+import GHCJS.DOM.NodeList (item, getLength)

45+import GHCJS.DOM.ParentNode (querySelectorAll)

3446import Language.Javascript.JSaddle (JSM)

3547import Obelisk.Frontend.Cookie

3648import Obelisk.Route.Frontend

3749import Reflex.Dom.Core

3850import Reflex.Host.Class

51+import Obelisk.ExecutableConfig.Frontend

3952import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)

53+import Obelisk.ExecutableConfig.Lookup (getConfigs)

4054import Web.Cookie

4155

4256makePrisms ''Sum

@@ -60,16 +74,16 @@ type ObeliskWidget js t route m =

6074 , Prerender js t m

6175 , PrebuildAgnostic t route m

6276 , PrebuildAgnostic t route (Client m)

77+ , HasFrontendConfigs m

6378 , HasCookies m

64− -- TODO Remove these. Probably requires a new class to allow executable-configs to work without being inside a `prerender`

65− , MonadIO m

66− , MonadIO (Performable m)

6779 )

6880

6981type PrebuildAgnostic t route m =

7082 ( SetRoute t route m

7183 , RouteToUrl route m

7284 , MonadFix m

85+ , HasFrontendConfigs m

86+ , HasFrontendConfigs (Performable m)

7387 )

7488

7589data Frontend route = Frontend

@@ -77,12 +91,40 @@ data Frontend route = Frontend

7791 , _frontend_body :: !(forall js t m. ObeliskWidget js t route m => RoutedT t route m ())

7892 }

7993

94+baseTag :: forall route js t m. ObeliskWidget js t route m => RoutedT t route m ()

95+baseTag = elAttr "base" ("href" =: "/") blank --TODO: Figure out the base URL from the routes

96+

97+removeHTMLConfigs :: JSM ()

98+removeHTMLConfigs = void $ runMaybeT $ do

99+ doc <- MaybeT currentDocument

100+ hd <- MaybeT $ getHead doc

101+ es <- collToList =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)

102+ for_ es $ removeChild_ hd

103+ where

104+ collToList es = do

105+ len <- getLength es

106+ lst <- traverse (item es) $ take (fromIntegral len) $ [0..] -- fun with unsigned types ...

107+ pure $ catMaybes lst

108+

80109runFrontend

81110 :: forall backendRoute route

82111 . Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

83112 -> Frontend (R route)

84113 -> JSM ()

85114runFrontend validFullEncoder frontend = do

115+ configs <- liftIO getConfigs

116+#ifdef ghcjs_HOST_OS

117+ removeHTMLConfigs

118+#endif

119+ runFrontendWithConfigs configs validFullEncoder frontend

120+

121+runFrontendWithConfigs

122+ :: forall backendRoute route

123+ . Map Text Text

124+ -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

125+ -> Frontend (R route)

126+ -> JSM ()

127+runFrontendWithConfigs configs validFullEncoder frontend = do

86128 let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _InR . _ObeliskRoute_App))

87129 errorLeft = \case

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

@@ -90,11 +132,13 @@ runFrontend validFullEncoder frontend = do

90132 runHydrationWidgetWithHeadAndBody (pure ()) $ \appendHead appendBody -> do

91133 rec switchover <- runRouteViewT ve switchover $ do

92134 (switchover'', fire) <- newTriggerEvent

93− mapRoutedT (mapSetRouteT (mapRouteToUrlT appendHead)) $ do

135+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runFrontendConfigsT configs))) $ do

136+ -- The order here is important - baseTag has to be before headWidget!

137+ baseTag

94138 _frontend_head frontend

95− mapRoutedT (mapSetRouteT (mapRouteToUrlT appendBody)) $ do

139+ mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runFrontendConfigsT configs))) $ do

96140 _frontend_body frontend

97− switchover' <- lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

141+ switchover' <- lift $ lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

98142 performEvent_ $ liftIO (fire ()) <$ switchover'

99143 pure switchover''

100144 pure ()

@@ -102,21 +146,26 @@ runFrontend validFullEncoder frontend = do

102146renderFrontendHtml

103147 :: ( t ~ DomTimeline

104148 , MonadIO m

105− , widget ~ RoutedT t r (SetRouteT t r' (RouteToUrlT r' (CookiesT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost))))))

149+ , widget ~ RoutedT t r (SetRouteT t r (RouteToUrlT r (FrontendConfigsT (CookiesT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost)))))))

106150 )

107− => Cookies

108− -> (r' -> Text)

151+ => Map Text Text

152+ -> Cookies

153+ -> (r -> Text)

109154 -> r

155+ -> Frontend r

110156 -> widget ()

111157 -> widget ()

112158 -> m ByteString

113−renderFrontendHtml cookies urlEnc route headWidget bodyWidget = do

159+renderFrontendHtml configs cookies urlEnc route frontend headExtra bodyExtra = do

114160 --TODO: We should probably have a "NullEventWriterT" or a frozen reflex timeline

115− html <- fmap snd $ liftIO $ renderStatic $ fmap fst $ runCookiesT cookies $ flip runRouteToUrlT urlEnc $ runSetRouteT $ flip runRoutedT (pure route) $

161+ html <- fmap snd $ liftIO $ renderStatic $ fmap fst $ runCookiesT cookies $ runFrontendConfigsT configs $ flip runRouteToUrlT urlEnc $ runSetRouteT $ flip runRoutedT (pure route) $

116162 el "html" $ do

117163 el "head" $ do

118− let baseTag = elAttr "base" ("href" =: "/") blank --TODO: Figure out the base URL from the routes

119− -- The order here is important - baseTag has to be before headWidget!

120− baseTag >> injectExecutableConfigs >> headWidget

121− el "body" bodyWidget

164+ baseTag

165+ injectExecutableConfigs configs

166+ _frontend_head frontend

167+ headExtra

168+ el "body" $ do

169+ _frontend_body frontend

170+ bodyExtra

122171 return $ "<!DOCTYPE html>" <> html

lib/frontend/src/Obelisk/Frontend/Cookie.hs+3

@@ -26,6 +26,7 @@ import GHCJS.DOM.Document (getCookie, Document)

2626import GHCJS.DOM.Types (MonadJSM)

2727import Web.Cookie

2828

29+import Obelisk.ExecutableConfig.Frontend

2930import Obelisk.Route.Frontend

3031

3132class Monad m => HasCookies m where

@@ -45,6 +46,8 @@ instance HasCookies m => HasCookies (SetRouteT t r m)

4546instance HasCookies m => HasCookies (StaticDomBuilderT t m)

4647instance HasCookies m => HasCookies (TriggerEventT t m)

4748instance HasCookies m => HasCookies (RoutedT t r m)

49+instance HasCookies m => HasCookies (FrontendConfigsT m)

50+instance HasFrontendConfigs m => HasFrontendConfigs (CookiesT m)

4851

4952newtype CookiesT m a = CookiesT { unCookiesT :: ReaderT Cookies m a }

5053 deriving

lib/route/obelisk-route.cabal+1

@@ -21,6 +21,7 @@ library

2121 monad-control,

2222 mtl,

2323 network-uri,

24+ obelisk-executable-config-frontend,

2425 primitive,

2526 ref-tf,

2627 reflex,

lib/route/src/Obelisk/Route.hs+1−1

@@ -149,7 +149,7 @@ import Text.Read (readMaybe)

149149

150150type R f = DSum f Identity --TODO: Better name

151151

152−--TODO: COMPLETE pragma

152+{-# COMPLETE (:/) #-}

153153infixr 5 :/

154154pattern (:/) :: f a -> a -> R f

155155pattern a :/ b = a :=> Identity b

lib/route/src/Obelisk/Route/Frontend.hs+31

@@ -51,10 +51,12 @@ module Obelisk.Route.Frontend

5151 , runRouteToUrlT

5252 , mapRouteToUrlT

5353 , routeLink

54+ , dynRouteLink

5455 ) where

5556

5657import Prelude hiding ((.), id)

5758

59+import Obelisk.ExecutableConfig.Frontend

5860import Obelisk.Route

5961

6062import Control.Category (Category (..), (.))

@@ -176,6 +178,8 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RoutedT t r m) where

176178 askQueryResult = lift askQueryResult

177179 queryIncremental = lift . queryIncremental

178180

181+instance HasFrontendConfigs m => HasFrontendConfigs (RoutedT t r m)

182+

179183instance (Monad m, RouteToUrl r m) => RouteToUrl r (QueryT t q m)

180184

181185instance (Monad m, SetRoute t r m) => SetRoute t r (QueryT t q m)

@@ -338,6 +342,8 @@ instance PrimMonad m => PrimMonad (SetRouteT t r m ) where

338342 type PrimState (SetRouteT t r m) = PrimState m

339343 primitive = lift . primitive

340344

345+instance HasFrontendConfigs m => HasFrontendConfigs (SetRouteT t r m)

346+

341347instance (MonadHold t m, Adjustable t m) => Adjustable t (SetRouteT t r m) where

342348 runWithReplace a0 a' = SetRouteT $ runWithReplace (coerce a0) $ coerceEvent a'

343349 traverseIntMapWithKeyWithAdjust f a0 a' = SetRouteT $ traverseIntMapWithKeyWithAdjust (coerce f) (coerce a0) $ coerce a'

@@ -435,6 +441,8 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (RouteToUrlT r m) where

435441 askQueryResult = lift askQueryResult

436442 queryIncremental = lift . queryIncremental

437443

444+instance HasFrontendConfigs m => HasFrontendConfigs (RouteToUrlT t m)

445+

438446runRouteViewT

439447 :: forall t m r a.

440448 ( TriggerEvent t m

@@ -503,6 +511,29 @@ routeLink r w = do

503511 setRoute $ r <$ domEvent Click e

504512 return a

505513

514+-- | A link widget that, when clicked, sets the route to current value of the

515+-- provided dynamic route. In non-javascript contexts the value of the dynamic post

516+-- build is used so the link still works like 'routeLink'.

517+dynRouteLink

518+ :: forall t m a route.

519+ ( DomBuilder t m

520+ , PostBuild t m

521+ , RouteToUrl (R route) m

522+ , SetRoute t (R route) m

523+ )

524+ => Dynamic t (R route) -- ^ Target route

525+ -> m a -- ^ Child widget

526+ -> m a

527+dynRouteLink dr w = do

528+ enc <- askRouteToUrl

529+ er <- dynamicAttributesToModifyAttributes $ ("href" =:) . enc <$> dr

530+ let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))

531+ & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)

532+ & elementConfig_modifyAttributes .~ er

533+ (e, a) <- element "a" cfg w

534+ setRoute $ tag (current dr) $ domEvent Click e

535+ return a

536+

506537-- On ios due to sandboxing when loading the page from a file adapt the

507538-- path to be based on the hash.

508539

lib/run/obelisk-run.cabal+2−1

@@ -10,6 +10,7 @@ library

1010 attoparsec

1111 , base

1212 , bytestring

13+ , containers

1314 , cookie

1415 , dependent-sum

1516 , dependent-sum-template

@@ -25,7 +26,7 @@ library

2526 , network

2627 , obelisk-asset-serve-snap

2728 , obelisk-backend

28− , obelisk-executable-config

29+ , obelisk-executable-config-backend

2930 , obelisk-frontend

3031 , obelisk-route

3132 , process

lib/run/src/Obelisk/Run.hs+42−22

@@ -26,6 +26,8 @@ import Data.Dependent.Sum (DSum (..))

2626import Data.Functor.Identity

2727import Data.Functor.Sum

2828import Data.List (uncons)

29+import Data.Map (Map)

30+import qualified Data.Map as Map

2931import Data.Maybe

3032import Data.Semigroup ((<>))

3133import Data.Streaming.Network (bindPortTCP)

@@ -46,7 +48,7 @@ import Network.WebSockets (ConnectionOptions)

4648import Network.WebSockets.Connection (defaultConnectionOptions)

4749import qualified Obelisk.Asset.Serve.Snap as Snap

4850import Obelisk.Backend

49−import Obelisk.ExecutableConfig (get)

51+import Obelisk.ExecutableConfig.Backend

5052import Obelisk.Frontend

5153import Obelisk.Route.Frontend

5254import Reflex.Dom.Core

@@ -73,23 +75,27 @@ run port serveStaticAsset backend frontend = do

7375 case checkEncoder $ _backend_routeEncoder backend of

7476 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e

7577 Right validFullEncoder -> do

78+ configs <- getComponentConfigs

7679 backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do

77− _backend_run backend $ \serveRoute -> do

78− runSnapWithCommandLineArgs $ do

79− getRouteWith validFullEncoder >>= \case

80− Identity r -> case r of

81− InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

82− InR obeliskRoute :=> Identity a ->

83− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend $ obeliskRoute :/ a

80+ runBackendConfigsT (_componentConfigs_backend configs) $

81+ _backend_run backend $ \serveRoute -> do

82+ runSnapWithCommandLineArgs $ do

83+ getRouteWith validFullEncoder >>= \case

84+ Identity r -> case r of

85+ InL backendRoute :=> Identity a ->

86+ runBackendConfigsT (_componentConfigs_backend configs) $

87+ serveRoute $ backendRoute :/ a

88+ InR obeliskRoute :=> Identity a ->

89+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend (_componentConfigs_frontend configs) $ obeliskRoute :/ a

8490 let conf = defRunConfig { _runConfig_redirectPort = port }

85− runWidget conf frontend validFullEncoder `finally` killThread backendTid

91+ runWidget conf (_componentConfigs_frontend configs) frontend validFullEncoder `finally` killThread backendTid

8692

8793-- Convenience wrapper to handle path segments for 'Snap.serveAsset'

8894runServeAsset :: FilePath -> [Text] -> Snap ()

8995runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate "/"

9096

91−getConfigRoute :: IO (Maybe URI)

92−getConfigRoute = get "config/common/route" >>= \case

97+getConfigRoute :: Map Text Text -> IO (Maybe URI)

98+getConfigRoute configs = case Map.lookup "common/route" configs of

9399 Just r -> case URI.mkURI $ T.strip r of

94100 Just route -> pure $ Just route

95101 Nothing -> do

@@ -100,9 +106,14 @@ getConfigRoute = get "config/common/route" >>= \case

100106defAppUri :: URI

101107defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"

102108

103−runWidget :: RunConfig -> Frontend (R route) -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName -> IO ()

104−runWidget conf frontend validFullEncoder = do

105− uri <- fromMaybe defAppUri <$> getConfigRoute

109+runWidget

110+ :: RunConfig

111+ -> Map Text Text

112+ -> Frontend (R route)

113+ -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

114+ -> IO ()

115+runWidget conf configs frontend validFullEncoder = do

116+ uri <- fromMaybe defAppUri <$> getConfigRoute configs

106117 let port = fromIntegral $ fromMaybe 80 $ uri ^? uriAuthority . _Right . authPort . _Just

107118 redirectHost = _runConfig_redirectHost conf

108119 redirectPort = _runConfig_redirectPort conf

@@ -114,19 +125,22 @@ runWidget conf frontend validFullEncoder = do

114125 close

115126 (\skt -> do

116127 man <- newManager defaultManagerSettings

117− app <- obeliskApp defaultConnectionOptions frontend validFullEncoder uri $ fallbackProxy redirectHost redirectPort man

128+ app <- obeliskApp configs defaultConnectionOptions frontend validFullEncoder uri $ fallbackProxy redirectHost redirectPort man

118129 runSettingsSocket settings skt app)

119130

120131obeliskApp

121− :: forall route backendRoute. ConnectionOptions

132+ :: forall route backendRoute

133+ . Map Text Text

134+ -> ConnectionOptions

122135 -> Frontend (R route)

123136 -> Encoder Identity Identity (R (Sum backendRoute (ObeliskRoute route))) PageName

124137 -> URI

125138 -> Application

126139 -> IO Application

127−obeliskApp opts frontend validFullEncoder uri backend = do

140+obeliskApp configs opts frontend validFullEncoder uri backend = do

128141 let entryPoint = do

129− runFrontend validFullEncoder frontend

142+ removeHTMLConfigs

143+ runFrontendWithConfigs configs validFullEncoder frontend

130144 syncPoint

131145 jsaddlePath <- URI.mkPathPiece "jsaddle"

132146 let jsaddleUri = BSLC.fromStrict $ URI.renderBs $ uri & uriPath %~ (<>[jsaddlePath])

@@ -141,15 +155,21 @@ obeliskApp opts frontend validFullEncoder uri backend = do

141155 }

142156 InR (ObeliskRoute_App appRouteComponent) :=> Identity appRouteRest -> do

143157 let cookies = maybe [] parseCookies $ lookup (fromString "Cookie") (W.requestHeaders req)

144− html <- renderJsaddleFrontend cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend

158+ html <- renderJsaddleFrontend configs cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend

145159 sendResponse $ W.responseLBS H.status200 [("Content-Type", staticRenderContentType)] $ BSLC.fromStrict html

146160 _ -> backend req sendResponse

147161

148−renderJsaddleFrontend :: Cookies -> (route -> Text) -> route -> Frontend route -> IO ByteString

149−renderJsaddleFrontend cookies urlEnc r f =

162+renderJsaddleFrontend

163+ :: Map Text Text

164+ -> Cookies

165+ -> (route -> Text)

166+ -> route

167+ -> Frontend route

168+ -> IO ByteString

169+renderJsaddleFrontend configs cookies urlEnc r f =

150170 let jsaddleScript = elAttr "script" ("src" =: "/jsaddle/jsaddle.js") blank

151171 jsaddlePreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "/jsaddle/jsaddle.js") blank

152− in renderFrontendHtml cookies urlEnc r (_frontend_head f >> jsaddlePreload) (_frontend_body f >> jsaddleScript)

172+ in renderFrontendHtml configs cookies urlEnc r f jsaddlePreload jsaddleScript

153173

154174-- | like 'bindPortTCP' but reconnects on exception

155175bindPortTCPRetry :: Settings

lib/selftest/obelisk-selftest.cabal+1

@@ -16,6 +16,7 @@ library

1616 , http-types

1717 , HUnit

1818 , obelisk-cliapp

19+ , obelisk-executable-config-lookup

1920 , obelisk-run

2021 , process

2122 , network

lib/selftest/src/Obelisk/SelfTest.hs+4−2

@@ -34,6 +34,7 @@ import Test.HUnit.Base

3434

3535import Obelisk.CliApp hiding (runCli, readCreateProcessWithExitCode)

3636import qualified Obelisk.CliApp as CliApp

37+import Obelisk.ExecutableConfig.Lookup (getConfigs)

3738import Obelisk.Run (getConfigRoute)

3839

3940data ObRunState

@@ -126,8 +127,9 @@ main = do

126127 void $ errExit False $ run "ob" ["init", "--symlink", "/dev/null"]

127128 ls tmp >>= liftIO . assertEqual "" []

128129

129− it "produces a valid route config" $ inTmpObInit $ \tmp -> do

130− liftIO $ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ getConfigRoute `shouldNotReturn` Nothing

130+ it "produces a valid route config" $ inTmpObInit $ \tmp -> liftIO $ do

131+ configs <- getConfigs

132+ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ getConfigRoute configs `shouldNotReturn` Nothing

131133

132134 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"

133135 -- when not run by 'nix-build --attr selftest'

release.nix+14−6

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

1−{ local-self ? import ./. {}

1+{ self-args ? {}

2+, local-self ? import ./. self-args

23}:

45let

@@ -9,7 +10,7 @@ let

910 obeliskPackagesCommon = [

1011 "obelisk-frontend"

1112 "obelisk-route"

12− "obelisk-executable-config"

13+ "obelisk-executable-config-lookup"

1314 ];

1415

1516 obeliskPackagesBackend = obeliskPackagesCommon ++ [

@@ -59,17 +60,24 @@ let

5960 (concatDepends ghcjs)

6061 ];

6162 command = local-self.command;

62− serverExeSkeleton = (import ./skeleton {}).exe;

63− builtSkeleton = (import ./skeleton {}).all;

63+ serverExeSkeleton = (import ./skeleton { obelisk = local-self; }).exe;

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

65+ iosObelisk = import ./. (self-args // {

66+ system = "x86_64-darwin";

67+ iosSdkVersion = "10.2";

68+ });

69+ iosSkeleton = (import ./skeleton { obelisk = iosObelisk; }).ios.frontend;

6470 in {

6571 inherit

6672 command

6773 ghc ghcjs

68− serverExeSkeleton builtSkeleton;

74+ serverExeSkeleton

75+ iosSkeleton

76+ androidSkeleton;

6977 cache = reflex-platform.pinBuildInputs

7078 "obelisk-${system}"

7179 cachePackages

72− [command serverExeSkeleton builtSkeleton];

80+ [command serverExeSkeleton iosSkeleton androidSkeleton];

7381 });

7482

7583 metaCache = local-self.pinBuildInputs

skeleton/default.nix+9−3

@@ -1,7 +1,13 @@

1−{ system ? builtins.currentSystem # TODO: Get rid of this system cruft

2−, iosSdkVersion ? "10.2"

1+{ obelisk ? import ./.obelisk/impl {

2+ system = builtins.currentSystem;

3+ iosSdkVersion = "10.2";

4+ # You must accept the Android Software Development Kit License Agreement at

5+ # https://developer.android.com/studio/terms in order to build Android apps.

6+ # Uncomment and set this to `true` to indicate your acceptance:

7+ # config.android_sdk.accept_license = false;

8+ }

39}:

4−with import ./.obelisk/impl { inherit system iosSdkVersion; };

10+with obelisk;

511project ./. ({ ... }: {

612 android.applicationId = "systems.obsidian.obelisk.examples.minimal";

713 android.displayName = "Obelisk Minimal Example";