git.iko.soy/obelisk
on master help sign in
Merge branch 'develop' into db-app-cache-control
commitbe7db056066e43bb06b0806177b6ffa6701e3bab authorAli Abrar <aliabrar@gmail.com> dateWed 4 Sep 2019, 10:38 (7 years ago) parent6ad90801db5cf4
21 files changed+143−92
compare with master
unifiedsplit
CONTRIBUTING.md+5 ChangeLog.md+9−2 README.md+5 default.nix+9−8 dep/reflex-platform/github.json+3−3 lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+7−6 lib/backend/src/Obelisk/Backend.hs+5−4 lib/cliapp/src/Obelisk/CliApp/Demo.hs+2−1 lib/cliapp/src/Obelisk/CliApp/Process.hs+5−4 lib/cliapp/src/Obelisk/CliApp/Types.hs+7−3 lib/command/obelisk-command.cabal+1−1 lib/command/src/Obelisk/App.hs+5−2 lib/command/src/Obelisk/Command/Deploy.hs+16−16 lib/command/src/Obelisk/Command/Run.hs+6−3 lib/command/src/Obelisk/Command/Thunk.hs+2−2 lib/command/src/Obelisk/Command/Utils.hs+1−1 lib/command/src/Obelisk/Command/VmBuilder.hs+2−1 lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Lookup.hs+17−8 lib/frontend/src/Obelisk/Frontend.hs+16−9 lib/route/src/Obelisk/Route.hs+10−9 lib/selftest/src/Obelisk/SelfTest.hs+10−9
CONTRIBUTING.md+5
@@ -5,6 +5,7 @@ Contributions and issue reports are encouraged and appreciated!
55- [Opening Issues](#opening-issues)
66- [Submitting Changes](#submitting-changes)
77 - [Guidelines for Commit Messages](#guidelines-for-commit-messages)
8+ - [Guidelines for Pull Requests](#guidelines-for-pull-requests)
89 - [Code Quality](#code-quality)
910 - [Documentation](#documentation)
1011
@@ -34,6 +35,10 @@ Commits that update a dependency should include some information about why the d
3435#### Body
3536For 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.
3637
38+### Guidelines for Pull Requests
39+
40+Wherever possible, pull requests should add a single feature or fix a single bug. Pull requests should not bundle several unrelated changes.
41+
3742### Code Quality
3843
3944#### Warnings
ChangeLog.md+9−2
@@ -3,14 +3,21 @@
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.
44
55## Unreleased
6+
7+* Generalised pathSegmentEncoder, added pathFieldEncoder.
8+* Added some Prisms to the encoder library for manipulating DSums (perhaps they should get moved to dependent-sum before release?)
9+* Add "ob doc" command, which lists paths to haddock documentation for specified packages
10+* Bump reflex-platform so that obelisk now uses GHC 8.6.5 and the nixos-19.03 nixpkgs set
11+
12+## v0.2.0.0 - 2019-8-17
13+
614* Configs become ByteStrings.
715* FrontendConfigsT has been changed into ConfigsT and configs are made available via getConfig/getConfigs
816 * The frontend will still only have access to configs that are placed in config/frontend and config/common, while the backend has access to the entire contents of the config directory via `Obelisk.ExecutableConfig.Lookup.getConfigs`.
917* The backend no longer runs in BackendConfigsT.
1018* Add tabulation package. See Data.Tabulation for details.
1119* Add encoders for `DMap`, `HasFields` (cf. Data.Tabulation), and JSON.
12−* Generalised pathSegmentEncoder, added pathFieldEncoder.
13−* Added some Prisms to the encoder library for manipulating DSums (perhaps they should get moved to dependent-sum before release?)
20+* Use IP address for nginx proxy pass instead of localhost
1421
1522## v0.1.1.0 - 2019-05-17
1623
README.md+5
@@ -5,6 +5,7 @@ Obelisk provides an easy way to develop and deploy your [Reflex](https://github.
55- [Installing Obelisk](#installing-obelisk)
66- [Developing an Obelisk project](#developing-an-obelisk-project)
77 - [Hoogle](#hoogle)
8+ - [Adding Packages](#adding-packages)
89 - [Adding Package Overrides](#adding-package-overrides)
910- [Deploying](#deploying)
1011 - [Locally](#locally)
@@ -92,6 +93,10 @@ To enter a nix-shell from which you can run the hoogle command-line client or a
9293
9394`nix-shell -A shells.ghc --arg withHoogle true`
9495
96+### Adding packages
97+
98+In order to add package dependencies, declare them under the build-depends field in the appropriate cabal files (backend, common, and frontend each have their own). The corresponding Nix packages will automatically be selected when building.
99+
95100### Adding package overrides
96101
97102To add a version override to any Haskell package, or to add a Haskell package that doesn't exist in the nixpkgs used by Obelisk, use the `overrides` attribute in your project's `default.nix`. For example, to use a specific version of the `aeson` package, your `default.nix` will look like:
default.nix+9−8
@@ -32,13 +32,13 @@ let
3232 # Fix misc upstream packages
3333 (self: super: let
3434 pkgs = self.callPackage ({ pkgs }: pkgs) {};
35+ haskellLib = pkgs.haskell.lib;
3536 in {
36− hnix = pkgs.haskell.lib.dontCheck (self.callCabal2nix "hnix" (pkgs.fetchFromGitHub {
37− owner = "haskell-nix";
38− repo = "hnix";
39− rev = "42afdc21da5d9e076eab57eaa42bfdde938192b8";
40− sha256 = "0psw384dx9bw2dp93xrzw8rd9amvcwgzn64jzzwby7sfspj6k349";
41− }) {});
37+ hnix = haskellLib.overrideCabal (self.callHackage "hnix" "0.6.1" { these = self.these_0_8; }) (_: {
38+ jailbreak = true;
39+ doCheck = false;
40+ });
41+ hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};
4242 })
4343
4444 pkgs.obeliskExecutableConfig.haskellOverlay
@@ -202,7 +202,7 @@ in rec {
202202 enableACME = enableHttps;
203203 forceSSL = enableHttps;
204204 locations.${baseUrl} = {
205− proxyPass = "http://localhost:" + toString internalPort;
205+ proxyPass = "http://127.0.0.1:" + toString internalPort;
206206 proxyWebsockets = true;
207207 };
208208 };
@@ -211,10 +211,11 @@ in rec {
211211 wantedBy = [ "multi-user.target" ];
212212 after = [ "network.target" ];
213213 restartIfChanged = true;
214+ path = [ pkgs.gnutar ];
214215 script = ''
215216 ln -sft . '${exe}'/*
216217 mkdir -p log
217− exec ./backend ${backendArgs} >>backend.out 2>>backend.err </dev/null
218+ exec ./backend ${backendArgs} </dev/null
218219 '';
219220 serviceConfig = {
220221 User = user;
dep/reflex-platform/github.json+3−3
@@ -1,7 +1,7 @@
11{
22 "owner": "reflex-frp",
33 "repo": "reflex-platform",
4− "branch": "cg-bump-reflex-dom",
5− "rev": "b220ba089e2de2110eb22c5388e09d99e4321148",
6− "sha256": "0ds6bcw4p9q5x8h39djyqp5sp7wdzr9mmknsyjafn5l199hscppw"
4+ "branch": "aa-split-these",
5+ "rev": "4b4a2c8679d6f3042180d2974b31c43bfc506b91",
6+ "sha256": "185i8ccqk0xc05ckd921fs7nnaj88gihmlazny1dk004hxq78cj2"
77}
lib/asset/serve-snap/src/Obelisk/Asset/Serve/Snap.hs+7−6
@@ -19,6 +19,7 @@ import Control.Applicative ((<|>))
1919import Control.Exception (handleJust, try, throwIO)
2020import Control.Monad (forM, liftM)
2121import Control.Monad.IO.Class (liftIO)
22+import Control.Monad.Fail (MonadFail)
2223import Data.Attoparsec.ByteString (parseOnly, endOfInput)
2324import Data.ByteString (ByteString)
2425import qualified Data.ByteString as BS
@@ -38,7 +39,7 @@ import System.Posix (getFileStatus, fileSize)
3839-- current version of the asset
3940-- (e.g. @0rx5yvkkgkig2pcqf4ngi1l7vh89qqajdzc6aiayaibyhvj0d853-test.png@). Hashed
4041-- asset names will be sent with permanent caching headers.
41−serveAssets :: MonadSnap m => FilePath -> FilePath -> m ()
42+serveAssets :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> m ()
4243serveAssets = serveAssets' True
4344
4445-- | Serve static assets from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.
@@ -47,15 +48,15 @@ serveAssets = serveAssets' True
4748-- browser for the logical asset name (e.g. @test.png@) but instead the current
4849-- version of the asset with to point the browser at the unique filename for the
4950-- current version of the asset.
50−serveAssetsInPlace :: MonadSnap m => FilePath -> FilePath -> m ()
51+serveAssetsInPlace :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> m ()
5152serveAssetsInPlace = serveAssets' False
5253
5354-- | Like 'serveAssets', but only serves a single specified asset
54−serveAsset :: MonadSnap m => FilePath -> FilePath -> FilePath -> m ()
55+serveAsset :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> FilePath -> m ()
5556serveAsset = serveAsset' True
5657
5758-- | Like 'serveAssetsInPlace', but only serves a single specified asset
58−serveAssetInPlace :: MonadSnap m => FilePath -> FilePath -> FilePath -> m ()
59+serveAssetInPlace :: (MonadSnap m, MonadFail m) => FilePath -> FilePath -> FilePath -> m ()
5960serveAssetInPlace = serveAsset' False
6061
6162-- | Serve static assets from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.
@@ -63,13 +64,13 @@ serveAssetInPlace = serveAsset' False
6364-- For assets generated from @assets.nix@, the @Bool@ argument @doRedirect@ controls whether redirects will be sent to the browser if a request is made for
6465-- an unhashed asset name, e.g. @test.png@. For @True@, a redirect will be sent, yielding more round trips to the server but better caching behavior if the
6566-- asset doesn't change often. Conversely for @False@, the asset will be served "in place" but made uncacheable.
66−serveAssets' :: MonadSnap m => Bool -> FilePath -> FilePath -> m ()
67+serveAssets' :: (MonadSnap m, MonadFail m) => Bool -> FilePath -> FilePath -> m ()
6768serveAssets' doRedirect base fallback = do
6869 pRaw <- getSafePath
6970 serveAsset' doRedirect base fallback $ if "/" `isSuffixOf` pRaw || pRaw == "" then pRaw <> "index.html" else pRaw
7071
7172-- | Serve a single static asset from an asset directory generated via @assets.nix@ or, failing that, from a regular directory.
72−serveAsset' :: MonadSnap m => Bool -> FilePath -> FilePath -> FilePath -> m ()
73+serveAsset' :: (MonadFail m, MonadSnap m) => Bool -> FilePath -> FilePath -> FilePath -> m ()
7374serveAsset' doRedirect base fallback p = do
7475 assetType <- liftIO $ try $ BS.readFile $ base </> p </> "type"
7576 case assetType of
lib/backend/src/Obelisk/Backend.hs+5−4
@@ -26,6 +26,7 @@ import Prelude hiding (id, (.))
2626import Control.Category
2727import Control.Monad
2828import Control.Monad.Except
29+import Control.Monad.Fail (MonadFail)
2930import Control.Categorical.Bifunctor
3031import Data.ByteString (ByteString)
3132import qualified Data.ByteString.Char8 as BSC8
@@ -64,7 +65,7 @@ data GhcjsApp route = GhcjsApp
6465-- | Serve a frontend, which must be the same frontend that Obelisk has built and placed in the default location
6566--TODO: The frontend should be provided together with the asset paths so that this isn't so easily breakable; that will probably make this function obsolete
6667serveDefaultObeliskApp
67− :: (MonadSnap m, HasCookies m)
68+ :: (MonadSnap m, HasCookies m, MonadFail m)
6869 => (R appRoute
6970 -> Text)
7071 -> ([Text]
@@ -121,7 +122,7 @@ getRouteWith e = do
121122 return $ tryDecode e pageName
122123
123124serveObeliskApp
124− :: (MonadSnap m, HasCookies m)
125+ :: (MonadSnap m, HasCookies m, MonadFail m)
125126 => (R appRoute -> Text)
126127 -> ([Text] -> m ())
127128 -> GhcjsApp (R appRoute)
@@ -139,7 +140,7 @@ serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case
139140 writeText msg
140141 ResourceRoute_Version :=> Identity () -> doNotCache >> serveFileIfExistsAs "text/plain" "version"
141142
142−serveStaticAssets :: MonadSnap m => StaticAssets -> [Text] -> m ()
143+serveStaticAssets :: (MonadSnap m, MonadFail m) => StaticAssets -> [Text] -> m ()
143144serveStaticAssets assets pathSegments = serveAsset (_staticAssets_processed assets) (_staticAssets_unprocessed assets) $ T.unpack $ T.intercalate "/" pathSegments
144145
145146data StaticAssets = StaticAssets
@@ -157,7 +158,7 @@ staticRenderContentType = "text/html; charset=utf-8"
157158
158159--TODO: Don't assume we're being served at "/"
159160serveGhcjsApp
160− :: (MonadSnap m, HasCookies m)
161+ :: (MonadSnap m, HasCookies m, MonadFail m)
161162 => (R appRouteComponent -> Text)
162163 -> GhcjsApp (R appRouteComponent)
163164 -> Map Text ByteString
lib/cliapp/src/Obelisk/CliApp/Demo.hs+2−1
@@ -4,6 +4,7 @@
44module Obelisk.CliApp.Demo where
55
66import Control.Concurrent (threadDelay)
7+import Control.Monad.Fail
78import Control.Monad.IO.Class
89import Data.Semigroup ((<>))
910import qualified Data.Text as T
@@ -14,7 +15,7 @@ import Control.Monad.Catch (MonadMask)
1415import Obelisk.CliApp
1516
1617cliDemo
17− :: ( MonadIO m, MonadMask m
18+ :: ( MonadIO m, MonadMask m, MonadFail m
1819 , CliLog m, HasCliConfig e m, CliThrow e m, AsProcessFailure e, AsUnstructuredError e)
1920 => m ()
2021cliDemo = withSpinner "CLI Demo" $ do
lib/cliapp/src/Obelisk/CliApp/Process.hs+5−4
@@ -24,6 +24,7 @@ module Obelisk.CliApp.Process
2424
2525import Control.Monad ((<=<), join, void)
2626import Control.Monad.Except (throwError)
27+import Control.Monad.Fail
2728import Control.Monad.IO.Class (MonadIO, liftIO)
2829import Control.Lens (Prism', review)
2930import qualified Data.ByteString as BS
@@ -60,7 +61,7 @@ instance AsProcessFailure ProcessFailure where
6061 asProcessFailure = id
6162
6263readProcessAndLogStderr
63− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)
64+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)
6465 => Severity -> CreateProcess -> m Text
6566readProcessAndLogStderr sev process = do
6667 (out, _err) <- withProcess process $ \_out err -> do
@@ -82,7 +83,7 @@ readCreateProcessWithExitCode process = do
8283-- which case it is advisable to call it with a non-Error severity for stderr, like
8384-- `callProcessAndLogOutput (Debug, Debug)`.
8485readProcessAndLogOutput
85− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)
86+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)
8687 => (Severity, Severity) -> CreateProcess -> m Text
8788readProcessAndLogOutput (sev_out, sev_err) process = do
8889 (_, Just out, Just err, p) <- createProcess $ process
@@ -106,7 +107,7 @@ readProcessAndLogOutput (sev_out, sev_err) process = do
106107-- `callProcessAndLogOutput (Debug, Debug)`.
107108callProcessAndLogOutput
108109
109− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)
110+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)
110111 => (Severity, Severity) -> CreateProcess -> m ()
111112callProcessAndLogOutput (sev_out, sev_err) process =
112113 void $ withProcess process $ \out err -> do
@@ -150,7 +151,7 @@ callCommand cmd = do
150151 liftIO $ Process.callCommand cmd
151152
152153withProcess
153− :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)
154+ :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)
154155 => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)
155156withProcess process f = do -- TODO: Use bracket.
156157 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.
lib/cliapp/src/Obelisk/CliApp/Types.hs+7−3
@@ -6,12 +6,14 @@
66{-# LANGUAGE GeneralizedNewtypeDeriving #-}
77{-# LANGUAGE MultiParamTypeClasses #-}
88{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE StandaloneDeriving #-}
910{-# LANGUAGE UndecidableInstances #-}
1011module Obelisk.CliApp.Types where
1112
1213import Control.Concurrent.MVar (MVar)
1314import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
14−import Control.Monad.Log (LoggingT, MonadLog, Severity (..), WithSeverity (..), logMessage)
15+import Control.Monad.Fail (MonadFail)
16+import Control.Monad.Log (LoggingT(..), MonadLog, Severity (..), WithSeverity (..), logMessage)
1517import Control.Monad.Reader (MonadIO, ReaderT (..), MonadReader (..), ask, mapReaderT)
1618import Control.Monad.Writer (WriterT)
1719import Control.Monad.State (StateT)
@@ -45,9 +47,11 @@ type CliThrow e m = MonadError e m
4547putLog :: CliLog m => Severity -> Text -> m ()
4648putLog sev = logMessage . Output_Log . WithSeverity sev
4749
50+deriving instance MonadFail m => MonadFail (LoggingT Output m)
51+
4852newtype DieT e m a = DieT { unDieT :: ReaderT (e -> (Text, Int)) (LoggingT Output m) a }
4953 deriving
50− ( Functor, Applicative, Monad, MonadIO
54+ ( Functor, Applicative, Monad, MonadIO, MonadFail
5155 , MonadThrow, MonadCatch, MonadMask
5256 , MonadLog Output
5357 )
@@ -114,7 +118,7 @@ newtype CliT e m a = CliT
114118 { unCliT :: ReaderT (CliConfig e) (DieT e m) a
115119 }
116120 deriving
117− ( Functor, Applicative, Monad, MonadIO
121+ ( Functor, Applicative, Monad, MonadIO, MonadFail
118122 , MonadThrow, MonadCatch, MonadMask
119123 , MonadLog Output -- CliLog
120124 , MonadError e -- CliThrow
lib/command/obelisk-command.cabal+1−1
@@ -23,7 +23,7 @@ library
2323 , filepath
2424 , github
2525 , here
26− , hit
26+ , git
2727 , hnix
2828 , hpack
2929 , io-streams
lib/command/src/Obelisk/App.hs+5−2
@@ -12,6 +12,7 @@ module Obelisk.App where
1212
1313import Control.Lens
1414import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
15+import Control.Monad.Fail (MonadFail)
1516import Control.Monad.Reader (MonadIO, ReaderT (..), ask, runReaderT)
1617import Control.Monad.Writer (WriterT)
1718import Control.Monad.State (StateT)
@@ -61,10 +62,11 @@ newtype ObeliskT m a = ObeliskT
6162 { unObeliskT :: ReaderT Obelisk (CliT ObeliskError m) a
6263 }
6364 deriving
64− ( Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask
65+ ( Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadFail
6566 , MonadLog Output -- CliLog
6667 , MonadError ObeliskError -- CliThrow ObeliskError
67− , HasCliConfig ObeliskError)
68+ , HasCliConfig ObeliskError
69+ )
6870
6971instance MonadTrans ObeliskT where
7072 lift = ObeliskT . lift . lift
@@ -104,6 +106,7 @@ type MonadInfallibleObelisk m =
104106type MonadObelisk m =
105107 ( MonadInfallibleObelisk m
106108 , CliThrow ObeliskError m
109+ , MonadFail m
107110 )
108111
109112getObeliskUserStateDir :: IO FilePath
lib/command/src/Obelisk/Command/Deploy.hs+16−16
@@ -4,7 +4,6 @@
44{-# LANGUAGE ScopedTypeVariables #-}
55{-# LANGUAGE ViewPatterns #-}
66{-# LANGUAGE DeriveGeneric #-}
7−{-# LANGUAGE TypeApplications #-}
87module Obelisk.Command.Deploy where
98
109import Control.Lens
@@ -22,8 +21,8 @@ import qualified Data.Set as Set
2221import qualified Data.Text as T
2322import qualified Data.Text.IO as T
2423import GHC.Generics
25−import Nix.Convert
2624import Nix.Pretty
25+import Nix.String (principledMakeNixStringWithoutContext)
2726import Nix.Value
2827import System.Directory
2928import System.Environment (getEnvironment)
@@ -173,13 +172,14 @@ deployPush deployPath getNixBuilders = do
173172deployUpdate :: MonadObelisk m => FilePath -> m ()
174173deployUpdate deployPath = updateThunkToLatest (deployPath </> "src") Nothing
175174
176−keytoolToAndroidConfig :: KeytoolConfig -> HM.HashMap Text (NValueNF Identity)
177−keytoolToAndroidConfig conf = runIdentity $ do
178− path <- toValue $ Path $ _keytoolConfig_keystore conf
179− storepass <- toValue $ T.pack $ _keytoolConfig_storepass conf
180− alias <- toValue $ T.pack $ _keytoolConfig_alias conf
181− keypass <- toValue $ T.pack $ _keytoolConfig_keypass conf
182− return $ HM.fromList
175+keytoolToAndroidConfig :: KeytoolConfig -> HM.HashMap Text (NValue t Identity m)
176+keytoolToAndroidConfig conf =
177+ let path = nvPath $ _keytoolConfig_keystore conf
178+ fromStr = nvStr . principledMakeNixStringWithoutContext . T.pack
179+ storepass = fromStr $ _keytoolConfig_storepass conf
180+ alias = fromStr $ _keytoolConfig_alias conf
181+ keypass = fromStr $ _keytoolConfig_keypass conf
182+ in HM.fromList
183183 [ ("storeFile", path)
184184 , ("storePassword", storepass)
185185 , ("keyAlias", alias)
@@ -194,7 +194,7 @@ renderPlatformDeployment = \case
194194 Android -> "android"
195195 IOS -> "ios"
196196
197−deployMobile :: MonadObelisk m => PlatformDeployment -> [String] -> m ()
197+deployMobile :: forall m. MonadObelisk m => PlatformDeployment -> [String] -> m ()
198198deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do
199199 let srcDir = root </> "src"
200200 configDir = root </> "config"
@@ -224,12 +224,12 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do
224224 checkKeytoolConfExist <- liftIO $ doesFileExist keytoolConfPath
225225 unless checkKeytoolConfExist $ failWith "Missing android KeytoolConfig"
226226 keytoolConfContents <- liftIO $ BSL.readFile keytoolConfPath
227− liftIO $ putStrLn $ show keytoolConfContents
228− releaseKey <- case eitherDecode keytoolConfContents of
227+ liftIO $ print keytoolConfContents
228+ releaseKey :: String <- case eitherDecode keytoolConfContents :: Either String KeytoolConfig of
229229 Left err -> failWith $ T.pack err
230− Right conf -> do
231− let nvset = toValue @(HM.HashMap Text (NValueNF Identity)) @Identity @(NValueNF Identity) $ keytoolToAndroidConfig conf
232− return $ printNix $ runIdentity nvset
230+ Right conf -> return $
231+ (printNix :: MonadObelisk m => NValue t Identity m -> String) $
232+ nvSet (keytoolToAndroidConfig conf) HM.empty
233233 let expr = mconcat
234234 [ "with (import ", srcDir, " {});"
235235 , "android.frontend.override (drv: { "
@@ -255,7 +255,7 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do
255255 result <- nixCmd $ NixCmd_Build $ def
256256 & nixBuildConfig_outLink .~ OutLink_None
257257 & nixCmdConfig_target .~ nixBuildTarget
258− putLog Notice $ T.pack $ "Your recently built android apk can be found at the following path: " <> (show result)
258+ putLog Notice $ T.pack $ "Your recently built android apk can be found at the following path: " <> show result
259259 callProcessAndLogOutput (Notice, Error) $ proc (result </> "bin" </> "deploy") mobileArgs
260260 where
261261 withEcho showEcho f = do
lib/command/src/Obelisk/Command/Run.hs+6−3
@@ -73,7 +73,10 @@ run = do
7373 -- Check whether the impure static files are a derivation (and so must be built)
7474 if isDerivation == "1"
7575 then fmap T.strip $ readProcessAndLogStderr Debug $ -- Strip whitespace here because nix-build has no --raw option
76− proc "nix-build" ["-E", "(import " <> importableRoot <> "{}).passthru.staticFilesImpure"]
76+ proc "nix-build"
77+ [ "--no-out-link"
78+ , "-E", "(import " <> importableRoot <> "{}).passthru.staticFilesImpure"
79+ ]
7780 else readProcessAndLogStderr Debug $
7881 proc "nix" ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]
7982 putLog Debug $ "Assets impurely loaded from: " <> assets
@@ -115,12 +118,12 @@ parseCabalPackage dir = do
115118 then Just <$> liftIO (readUTF8File cabalFp)
116119 else if hasHpack
117120 then do
118− let decodeOptions = DecodeOptions hpackFp Nothing decodeYaml
121+ let decodeOptions = DecodeOptions (ProgramName "ob") hpackFp Nothing decodeYaml
119122 liftIO (readPackageConfig decodeOptions) >>= \case
120123 Left err -> do
121124 putLog Error $ T.pack $ "Failed to parse " <> hpackFp <> ": " <> err
122125 return Nothing
123− Right (DecodeResult hpackPackage _ _) -> do
126+ Right (DecodeResult hpackPackage _ _ _) -> do
124127 return $ Just $ renderPackage [] hpackPackage
125128 else return Nothing
126129
lib/command/src/Obelisk/Command/Thunk.hs+2−2
@@ -94,7 +94,7 @@ type NixSha256 = Text --TODO: Use a smart constructor and make this actually ver
9494
9595-- | A specific revision of data; it may be available from multiple sources
9696data ThunkRev = ThunkRev
97− { _thunkRev_commit :: Ref
97+ { _thunkRev_commit :: Ref Ref.SHA1
9898 , _thunkRev_nixSha256 :: NixSha256
9999 }
100100 deriving (Show, Eq, Ord)
@@ -149,7 +149,7 @@ getThunkGitBranch (ThunkPtr _ src) = fmap untagName $ case src of
149149 ThunkSource_GitHub s -> _gitHubSource_branch s
150150 ThunkSource_Git s -> _gitSource_branch s
151151
152−commitNameToRef :: Name Commit -> Ref
152+commitNameToRef :: Name Commit -> Ref Ref.SHA1
153153commitNameToRef (N c) = Ref.fromHex $ encodeUtf8 c
154154
155155-- TODO: Use spinner here.
lib/command/src/Obelisk/Command/Utils.hs+1−1
@@ -134,7 +134,7 @@ gitLsRemote repository mRef mBranch = do
134134 ["ls-remote", "--exit-code", repository, branchName]
135135 let t = T.pack out
136136 maps <- case MP.runParser parseLsRemote "" t of
137− Left err -> failWith $ T.pack $ MP.parseErrorPretty' t err
137+ Left err -> failWith $ T.pack $ MP.errorBundlePretty err
138138 Right table -> pure $ bimap M.fromList M.fromList $ partitionEithers $ table
139139 putLog Debug $ "git ls-remote maps: " <> T.pack (show maps)
140140 pure (exitCode, maps)
lib/command/src/Obelisk/Command/VmBuilder.hs+2−1
@@ -156,7 +156,8 @@ testLinuxBuild stateDir
156156 | System.Info.os == "linux" = failWith "Using the docker builder is not necessary on linux."
157157 | otherwise = do
158158 (exitCode, _stdout, stderr) <- readCreateProcessWithExitCode $ proc "nix-build"
159− [ "-E", "(import <nixpkgs> { system = \"x86_64-linux\"; }).writeText \"test\" builtins.currentTime"
159+ [ "--no-out-link"
160+ , "-E", "(import <nixpkgs> { system = \"x86_64-linux\"; }).writeText \"test\" builtins.currentTime"
160161 , "--builders", nixBuildersArgString stateDir
161162 ]
162163 unless (exitCode == ExitSuccess) $ do
lib/executable-config/lookup/src-ghcjs/Obelisk/ExecutableConfig/Lookup.hs+17−8
@@ -15,28 +15,37 @@ import GHCJS.DOM.Document (getHead)
1515import GHCJS.DOM.DOMStringMap (get)
1616import GHCJS.DOM.Element (getInnerHTML)
1717import GHCJS.DOM.HTMLElement (HTMLElement(HTMLElement), getDataset)
18−import GHCJS.DOM.NodeList (item, getLength)
18+import GHCJS.DOM.NodeList (IsNodeList, item, getLength)
1919import GHCJS.DOM.ParentNode (querySelectorAll)
20−import GHCJS.DOM.Types (Node(Node), castTo)
20+import GHCJS.DOM.Types (MonadJSM, Node(Node), castTo)
2121
2222getConfigs :: IO (Map Text ByteString)
2323getConfigs = do
2424 Just doc <- currentDocument
2525 Just hd <- getHead doc
26− nodes <- collToList =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)
26+ nodes <- nodeListNodes =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)
2727 fmap Map.fromList $ for nodes $ \node -> do
2828 e <- castTo HTMLElement node >>= \case
2929 Nothing -> error "Found node with data attribute obelisk-executable-config-inject-key that is not an HTMLElement."
3030 Just htmlE -> return htmlE
3131 dataset <- getDataset e
3232 (,)
33− <$> get dataset ("obelisk-executable-config-inject-key" :: Text)
33+ -- the key is camelCased: https://html.spec.whatwg.org/multipage/dom.html#dom-dataset
34+ <$> get dataset ("obeliskExecutableConfigInjectKey" :: Text)
3435 <*> (fmap decodeOrFail (getInnerHTML e))
3536 where
36− collToList es = do
37− len <- getLength es
38− list <- traverse (item es) $ if len == 0 then [] else [0..len-1]
39− pure $ catMaybes list
4037 decodeOrFail x = case B64.decode (T.encodeUtf8 x) of
4138 Left e -> error ("Obelisk.ExecutableConfig.Lookup.getConfigs: error when decoding base64: " ++ e)
4239 Right x' -> x'
40+
41+-- | Collect all nodes in the node list.
42+--
43+-- TODO: this and the version in obelisk-frontend should be
44+-- upstreamed to jsaddle.
45+nodeListNodes :: (IsNodeList l, MonadJSM m) => l -> m [Node]
46+nodeListNodes es = do
47+ len <- getLength es
48+ -- Warning! len is unsigned. If the NodeList is empty, we must avoid
49+ -- accidentally traversing over [0..maxBound::Word]
50+ nodes <- traverse (item es) $ if len == 0 then [] else [0..len-1]
51+ pure $ catMaybes nodes
lib/frontend/src/Obelisk/Frontend.hs+16−9
@@ -43,11 +43,11 @@ import qualified GHCJS.DOM as DOM
4343import qualified GHCJS.DOM.Types as DOM
4444import qualified GHCJS.DOM.History as DOM
4545import qualified GHCJS.DOM.Window as DOM
46−import Language.Javascript.JSaddle (JSM, jsNull)
46+import Language.Javascript.JSaddle (MonadJSM, JSM, jsNull)
4747import GHCJS.DOM (currentDocument)
4848import GHCJS.DOM.Document (getHead)
49−import GHCJS.DOM.Node (removeChild_)
50−import GHCJS.DOM.NodeList (item, getLength)
49+import GHCJS.DOM.Node (Node, removeChild_)
50+import GHCJS.DOM.NodeList (IsNodeList, item, getLength)
5151import GHCJS.DOM.ParentNode (querySelectorAll)
5252import Obelisk.Frontend.Cookie
5353import Obelisk.Route.Frontend
@@ -106,13 +106,20 @@ removeHTMLConfigs :: JSM ()
106106removeHTMLConfigs = void $ runMaybeT $ do
107107 doc <- MaybeT currentDocument
108108 hd <- MaybeT $ getHead doc
109− es <- collToList =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)
109+ es <- nodeListNodes =<< querySelectorAll hd ("[data-obelisk-executable-config-inject-key]" :: Text)
110110 for_ es $ removeChild_ hd
111− where
112− collToList es = do
113− len <- getLength es
114− lst <- traverse (item es) $ take (fromIntegral len) $ [0..] -- fun with unsigned types ...
115− pure $ catMaybes lst
111+
112+-- | Collect all nodes in the node list.
113+--
114+-- TODO: this and the version in exe-config/ghcjs/lookup should be
115+-- upstreamed to jsaddle.
116+nodeListNodes :: (IsNodeList l, MonadJSM m) => l -> m [Node]
117+nodeListNodes es = do
118+ len <- getLength es
119+ -- Warning! len is unsigned. If the NodeList is empty, we must avoid
120+ -- accidentally traversing over [0..maxBound::Word]
121+ nodes <- traverse (item es) $ if len == 0 then [] else [0..len-1]
122+ pure $ catMaybes nodes
116123
117124setInitialRoute :: Bool -> JSM ()
118125setInitialRoute useHash = do
lib/route/src/Obelisk/Route.hs+10−9
@@ -233,7 +233,7 @@ decode e x = runIdentity (tryDecode e x)
233233tryDecode :: Encoder Identity parse decoded encoded -> encoded -> parse decoded
234234tryDecode (Encoder (Identity impl)) x = _encoderImpl_decode impl x
235235
236−-- | Similar to 'decode' above, once an encoder has been checked so that its check monad is Identity, it
236+-- | Similar to 'decode', once an encoder has been checked so that its check monad is Identity, it
237237-- can be used to actually encode by using this. Note that while there's no constraint on the parse monad here,
238238-- one should usually be applying decode and encode to the same 'Encoder'
239239encode :: Encoder Identity parse decoded encoded -> decoded -> encoded
@@ -505,8 +505,9 @@ chainEncoder cons this rest = Encoder $ do
505505 pure $ EncoderImpl
506506 { _encoderImpl_decode = \v -> do
507507 (here, following) <- _encoderImpl_decode consValid v
508− Some r <- _encoderImpl_decode thisValid here
509− (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following
508+ _encoderImpl_decode thisValid here >>= \case
509+ Some r ->
510+ (r :/) <$> _encoderImpl_decode (runIdentity . unEncoder $ rest r) following
510511 , _encoderImpl_encode = \(r :/ s) ->
511512 _encoderImpl_encode consValid
512513 ( _encoderImpl_encode thisValid $ Some r
@@ -1046,12 +1047,12 @@ dmapEncoder keyEncoder' valueEncoderFor = unsafeEncoder $ do
10461047 , encode (toEncoder (DMap.findWithDefault (error . keyError $ gshow k') k' valueDecoders)) v'
10471048 )
10481049 , _encoderImpl_decode = \m -> fmap DMap.fromList . forM (Map.toList m) $ \(k,v) -> do
1049− Some (k' :: k' t) <- tryDecode keyEncoder k
1050− case DMap.lookup k' valueDecoders of
1051− Nothing -> throwError . T.pack . keyError $ gshow k'
1052− Just (Decoder e) -> do
1053− v' <- tryDecode e v
1054− return (k' :=> Identity v')
1050+ tryDecode keyEncoder k >>= \case
1051+ Some (k' :: k' t) -> case DMap.lookup k' valueDecoders of
1052+ Nothing -> throwError . T.pack . keyError $ gshow k'
1053+ Just (Decoder e) -> do
1054+ v' <- tryDecode e v
1055+ return (k' :=> Identity v')
10551056 }
10561057
10571058fieldMapEncoder :: forall check parse r.
lib/selftest/src/Obelisk/SelfTest.hs+10−9
@@ -75,6 +75,7 @@ main = do
7575 unless isVerbose $
7676 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"
7777 let verbosity = bool silently verbosely isVerbose
78+ nixBuild args = run "nix-build" ("--no-out-link" : args)
7879 obeliskImpl <- fromString <$> getEnv "OBELISK_IMPL"
7980 httpManager <- HTTP.newManager HTTP.defaultManagerSettings
8081 [p0, p1, p2, p3] <- liftIO $ getFreePorts 4
@@ -141,22 +142,22 @@ main = do
141142 testObRunInDir p2 p3 (Just "frontend") httpManager
142143
143144 describe "obelisk project" $ parallel $ do
144− it "can build obelisk command" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "command" , obeliskImpl]
145− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "skeleton", obeliskImpl]
146− it "can build obelisk shell" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "shell", obeliskImpl]
145+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , obeliskImpl]
146+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", obeliskImpl]
147+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", obeliskImpl]
147148 -- See https://github.com/obsidiansystems/obelisk/issues/101
148− -- it "can build everything" $ shelly_ $ run "nix-build" [obeliskImpl]
149+ -- it "can build everything" $ shelly_ $ nixBuild [obeliskImpl]
149150
150151 describe "blank initialized project" $ parallel $ do
151152
152153 it "can build ghc.backend" $ inTmpObInit $ \_ -> do
153− run "nix-build" ["--no-out-link", "-A", "ghc.backend"]
154+ nixBuild ["-A", "ghc.backend"]
154155 it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> do
155− run "nix-build" ["--no-out-link", "-A", "ghcjs.frontend"]
156+ nixBuild ["-A", "ghcjs.frontend"]
156157
157158 if os == "darwin"
158− then it "can build ios" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "ios.frontend" ]
159− else it "can build android" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "android.frontend"]
159+ then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]
160+ else it "can build android" $ inTmpObInit $ \_ -> nixBuild ["-A", "android.frontend"]
160161
161162 forM_ ["ghc", "ghcjs"] $ \compiler -> do
162163 let
@@ -166,7 +167,7 @@ main = do
166167 it ("can build in " <> shell) $ inTmpObInit $ \_ -> inShell $ "cabal new-build --" <> fromString compiler <> " all"
167168
168169 it "can build reflex project" $ inTmpObInit $ \_ -> do
169− run "nix-build" []
170+ nixBuild []
170171
171172 it "has idempotent thunk update" $ inTmpObInit $ \_ -> do
172173 u <- update