master...87abcaa · obelisk

git.iko.soy/obelisk

7 files changed+62−27

since splitsnapshots

unifiedsplit

lib/cliapp/src/Obelisk/CliApp.hs+2 lib/cliapp/src/Obelisk/CliApp/Process.hs+9−2 lib/command/src/Obelisk/Command/Run.hs+35−12 lib/command/src/Obelisk/Command/Utils.hs+1−2 lib/command/src/Obelisk/Command/VmBuilder.hs+2−1 lib/selftest/src/Obelisk/SelfTest.hs+10−9 skeleton/default.nix+3−1

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

@@ -43,6 +43,8 @@ module Obelisk.CliApp

4343 , callProcess

4444 , callCommand

4545 , reconstructCommand

46+ , shellQuoteAndEscapeDouble

47+ , shellQuoteAndEscapeSingle

4648 ) where

4749

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

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

@@ -20,6 +20,8 @@ module Obelisk.CliApp.Process

2020 , callProcess

2121 , callCommand

2222 , reconstructCommand

23+ , shellQuoteAndEscapeDouble

24+ , shellQuoteAndEscapeSingle

2325 ) where

2426

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

@@ -181,5 +183,10 @@ reconstructCommand :: Process.CmdSpec -> Text

181183reconstructCommand (Process.ShellCommand str) = T.pack str

182184reconstructCommand (Process.RawCommand c as) = processToShellString c as

183185 where

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

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

186+ processToShellString cmd args = T.unwords $ map (shellQuoteAndEscapeSingle . T.pack) (cmd : args)

187+

188+shellQuoteAndEscapeSingle :: Text -> Text

189+shellQuoteAndEscapeSingle x = "'" <> T.replace "'" "'\''" x <> "'"

190+

191+shellQuoteAndEscapeDouble :: Text -> Text

192+shellQuoteAndEscapeDouble x = "\"" <> T.replace "\"" "\\\"" x <> "\""

lib/command/src/Obelisk/Command/Run.hs+35−12

@@ -31,13 +31,14 @@ import System.Directory

3131import System.FilePath

3232import System.Process (proc)

3333import System.IO.Temp (withSystemTempDirectory)

34+import Text.Read (readMaybe)

3435import Data.ByteString (ByteString)

3536

3637import Obelisk.App (MonadObelisk, ObeliskT)

3738import Obelisk.CliApp

3839 ( CliT (..), HasCliConfig, Severity (..)

3940 , callCommand, failWith, getCliConfig, putLog

40− , readProcessAndLogStderr, runCli)

41+ , readProcessAndLogStderr, runCli, shellQuoteAndEscapeDouble)

4142import Obelisk.Command.Project (inProjectShell, withProjectRoot)

4243

4344data CabalPackageInfo = CabalPackageInfo

@@ -55,15 +56,12 @@ run = do

5556 withGhciScript pkgs $ \dotGhciPath -> do

5657 freePort <- getFreePort

5758 assets <- withProjectRoot "." $ \root -> do

58− let importableRoot = if "/" `isInfixOf` root

59− then root

60− else "./" <> root

6159 isDerivation <- readProcessAndLogStderr Debug $

6260 proc "nix"

6361 [ "eval"

6462 , "-f"

6563 , root

66− , "(let a = import " <> importableRoot <> " {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"

64+ , "(let a = import " <> importablePath root <> " {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"

6765 , "--raw"

6866 -- `--raw` is not available with old nix-instantiate. It drops quotation

6967 -- marks and trailing newline, so is very convenient for shelling out.

@@ -71,11 +69,15 @@ run = do

7169 -- Check whether the impure static files are a derivation (and so must be built)

7270 if isDerivation == "1"

7371 then fmap T.strip $ readProcessAndLogStderr Debug $ -- Strip whitespace here because nix-build has no --raw option

74− proc "nix-build" ["-E", "(import " <> importableRoot <> "{}).passthru.staticFilesImpure"]

72+ proc "nix-build"

73+ [ "--no-out-link"

74+ , "-E", "(import " <> importablePath root <> "{}).passthru.staticFilesImpure"

75+ ]

7576 else readProcessAndLogStderr Debug $

7677 proc "nix" ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]

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

78− runGhcid dotGhciPath $ Just $ unwords

79+ extraGhciArgs <- getExtraGhciArgs

80+ runGhcid dotGhciPath extraGhciArgs $ Just $ unwords

7981 [ "Obelisk.Run.run"

8082 , show freePort

8183 , "(runServeAsset " ++ show assets ++ ")"

@@ -87,12 +89,14 @@ runRepl :: MonadObelisk m => m ()

8789runRepl = do

8890 pkgs <- getLocalPkgs

8991 withGhciScript pkgs $ \dotGhciPath -> do

90− runGhciRepl dotGhciPath

92+ runGhciRepl dotGhciPath =<< getExtraGhciArgs

9193

9294runWatch :: MonadObelisk m => m ()

9395runWatch = do

9496 pkgs <- getLocalPkgs

95− withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath Nothing

97+ withGhciScript pkgs $ \dotGhciPath -> do

98+ ghciArgs <- getExtraGhciArgs

99+ runGhcid dotGhciPath ghciArgs Nothing

96100

97101-- | Relative paths to local packages of an obelisk project

98102-- TODO a way to query this

@@ -189,21 +193,24 @@ withGhciScript pkgs f = do

189193runGhciRepl

190194 :: MonadObelisk m

191195 => FilePath -- ^ Path to .ghci

196+ -> [String] -- ^ Extra ghci arguments

192197 -> m ()

193−runGhciRepl dotGhci = inProjectShell "ghc" $ unwords $ "ghci" : ["-no-user-package-db", "-ghci-script", dotGhci]

198+runGhciRepl dotGhci ghciArgs = inProjectShell "ghc" $ unwords $ "ghci" : ["-no-user-package-db", "-ghci-script", dotGhci] ++ ghciArgs

194199

195200-- | Run ghcid

196201runGhcid

197202 :: MonadObelisk m

198203 => FilePath -- ^ Path to .ghci

204+ -> [String] -- ^ Extra ghci arguments

199205 -> Maybe String -- ^ Optional command to run at every reload

200206 -> m ()

201−runGhcid dotGhci mcmd = callCommand $ unwords $ "ghcid" : opts

207+runGhcid dotGhci ghciArgs mcmd = callCommand $ unwords $ "ghcid" : opts

202208 where

203209 opts =

204210 [ "-W"

205211 --TODO: The decision of whether to use -fwarn-redundant-constraints should probably be made by the user

206− , "--command='ghci -Wall -ignore-dot-ghci -fwarn-redundant-constraints -no-user-package-db -ghci-script " <> dotGhci <> "' "

212+ , "--command='ghci -Wall -ignore-dot-ghci -fwarn-redundant-constraints -no-user-package-db -ghci-script " <> dotGhci

213+ <> " " <> T.unpack (T.unwords $ fmap (shellQuoteAndEscapeDouble . T.pack) ghciArgs) <> "' "

207214 , "--reload=config"

208215 , "--outputfile=ghcid-output.txt"

209216 ] <> testCmd

@@ -218,3 +225,19 @@ getFreePort = liftIO $ withSocketsDo $ do

218225 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

219226 bind sock (addrAddress addr)

220227 return sock

228+

229+getExtraGhciArgs :: MonadObelisk m => m [String]

230+getExtraGhciArgs = withProjectRoot "." $ \root -> do

231+ let attr = "dev.extraGhciArgs"

232+ value <- readProcessAndLogStderr Error (

233+ proc "nix"

234+ [ "eval"

235+ , "--json"

236+ , "(import " <> importablePath root <> " {})." <> attr <> " or []"

237+ ])

238+ case readMaybe (T.unpack value) of

239+ Nothing -> [] <$ putLog Error ("Unable to parse " <> T.pack attr <> ": " <> value)

240+ Just v -> return v

241+

242+importablePath :: String -> String

243+importablePath x = if "/" `isInfixOf` x then x else "./" <> x

lib/command/src/Obelisk/Command/Utils.hs+1−2

@@ -83,8 +83,7 @@ readGitProcessNoRepo :: MonadObelisk m => [String] -> m Text

8383readGitProcessNoRepo = readProcessAndLogOutput (Debug, Notice) . gitProcNoRepo

8484

8585processToShellString :: FilePath -> [String] -> String

86−processToShellString cmd args = unwords $ map quoteAndEscape (cmd : args)

87− where quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

86+processToShellString cmd args = T.unpack $ T.unwords $ map (shellQuoteAndEscapeSingle . T.pack) (cmd : args)

8887

8988-- | A simpler wrapper for CliApp's most used process function with sensible defaults.

9089runProc :: MonadObelisk m => P.CreateProcess -> m ()

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/selftest/src/Obelisk/SelfTest.hs+10−9

@@ -74,6 +74,7 @@ main = do

7474 unless isVerbose $

7575 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"

7676 let verbosity = bool silently verbosely isVerbose

77+ nixBuild args = run "nix-build" ("--no-out-link" : args)

7778 obeliskImpl <- fromString <$> getEnv "OBELISK_IMPL"

7879 httpManager <- HTTP.newManager HTTP.defaultManagerSettings

7980 [p0, p1, p2, p3] <- liftIO $ getFreePorts 4

@@ -138,22 +139,22 @@ main = do

138139 testObRunInDir p2 p3 (Just "frontend") httpManager

139140

140141 describe "obelisk project" $ parallel $ do

141− it "can build obelisk command" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "command" , obeliskImpl]

142− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "skeleton", obeliskImpl]

143− it "can build obelisk shell" $ inTmpObInit $ \_ -> run "nix-build" ["-A", "shell", obeliskImpl]

142+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , obeliskImpl]

143+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", obeliskImpl]

144+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", obeliskImpl]

144145 -- See https://github.com/obsidiansystems/obelisk/issues/101

145− -- it "can build everything" $ shelly_ $ run "nix-build" [obeliskImpl]

146+ -- it "can build everything" $ shelly_ $ nixBuild [obeliskImpl]

146147

147148 describe "blank initialized project" $ parallel $ do

148149

149150 it "can build ghc.backend" $ inTmpObInit $ \_ -> do

150− run "nix-build" ["--no-out-link", "-A", "ghc.backend"]

151+ nixBuild ["-A", "ghc.backend"]

151152 it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> do

152− run "nix-build" ["--no-out-link", "-A", "ghcjs.frontend"]

153+ nixBuild ["-A", "ghcjs.frontend"]

153154

154155 if os == "darwin"

155− then it "can build ios" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "ios.frontend" ]

156− else it "can build android" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "android.frontend"]

156+ then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]

157+ else it "can build android" $ inTmpObInit $ \_ -> nixBuild ["-A", "android.frontend"]

157158

158159 forM_ ["ghc", "ghcjs"] $ \compiler -> do

159160 let

@@ -163,7 +164,7 @@ main = do

163164 it ("can build in " <> shell) $ inTmpObInit $ \_ -> inShell $ "cabal new-build --" <> fromString compiler <> " all"

164165

165166 it "can build reflex project" $ inTmpObInit $ \_ -> do

166− run "nix-build" []

167+ nixBuild []

167168

168169 it "has idempotent thunk update" $ inTmpObInit $ \_ -> do

169170 u <- update

skeleton/default.nix+3−1

@@ -7,4 +7,6 @@ project ./. ({ ... }: {

77 android.displayName = "Obelisk Minimal Example";

88 ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";

99 ios.bundleName = "Obelisk Minimal Example";

10−})

10+}) // {

11+ dev.extraGhciArgs = [];

12+}