master...4fd646c · 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

@@ -57,15 +58,12 @@ run = do

5758 withGhciScript pkgs $ \dotGhciPath -> do

5859 freePort <- getFreePort

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

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

61− then root

62− else "./" <> root

6361 isDerivation <- readProcessAndLogStderr Debug $

6462 proc "nix"

6563 [ "eval"

6664 , "-f"

6765 , root

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

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

6967 , "--raw"

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

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

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

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

7472 if isDerivation == "1"

7573 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"]

74+ proc "nix-build"

75+ [ "--no-out-link"

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

77+ ]

7778 else readProcessAndLogStderr Debug $

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

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

80− runGhcid dotGhciPath $ Just $ unwords

81+ extraGhciArgs <- getExtraGhciArgs

82+ runGhcid dotGhciPath extraGhciArgs $ Just $ unwords

8183 [ "Obelisk.Run.run"

8284 , show freePort

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

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

8991runRepl = do

9092 pkgs <- getLocalPkgs

9193 withGhciScript pkgs $ \dotGhciPath -> do

92− runGhciRepl dotGhciPath

94+ runGhciRepl dotGhciPath =<< getExtraGhciArgs

9395

9496runWatch :: MonadObelisk m => m ()

9597runWatch = do

9698 pkgs <- getLocalPkgs

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

99+ withGhciScript pkgs $ \dotGhciPath -> do

100+ ghciArgs <- getExtraGhciArgs

101+ runGhcid dotGhciPath ghciArgs Nothing

98102

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

100104-- TODO a way to query this

@@ -202,21 +206,24 @@ warnDifferentLanguages _ = return ()

202206runGhciRepl

203207 :: MonadObelisk m

204208 => FilePath -- ^ Path to .ghci

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

205210 -> m ()

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

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

207212

208213-- | Run ghcid

209214runGhcid

210215 :: MonadObelisk m

211216 => FilePath -- ^ Path to .ghci

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

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

213219 -> m ()

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

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

215221 where

216222 opts =

217223 [ "-W"

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

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

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

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

220227 , "--reload=config"

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

222229 ] <> testCmd

@@ -231,3 +238,19 @@ getFreePort = liftIO $ withSocketsDo $ do

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

232239 bind sock (addrAddress addr)

233240 return sock

241+

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

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

244+ let attr = "dev.extraGhciArgs"

245+ value <- readProcessAndLogStderr Error (

246+ proc "nix"

247+ [ "eval"

248+ , "--json"

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

250+ ])

251+ case readMaybe (T.unpack value) of

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

253+ Just v -> return v

254+

255+importablePath :: String -> String

256+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

@@ -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

skeleton/default.nix+3−1

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

1313 android.displayName = "Obelisk Minimal Example";

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

1515 ios.bundleName = "Obelisk Minimal Example";

16−})

16+}) // {

17+ dev.extraGhciArgs = [];

18+}