14fb243 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Use custom 'ProcessSpec' type to facilitate custom process environments

14fb243Elliot Cameron7 years ago

lib/cliapp/obelisk-cliapp.cabal+1

compare with master

unifiedsplit

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

10 ansi-terminal

11 , base

12 , bytestring

13+ , containers

13 , exceptions

14 , exceptions

14 , io-streams

15 , io-streams

15 , lens

16 , lens

lib/cliapp/src/Obelisk/CliApp.hs+13−6

@@ -33,16 +33,23 @@ module Obelisk.CliApp

33 , Severity (..)

35 -- .Process

36− , ProcessFailure (..)

37 , AsProcessFailure (..)

36 , AsProcessFailure (..)

38− , readProcessAndLogStderr

37+ , ProcessFailure (..)

39− , readProcessAndLogOutput

38+ , ProcessSpec (..)

40− , readCreateProcessWithExitCode

39+ , callCommand

40+ , callProcess

41 , callProcessAndLogOutput

42 , createProcess_

43− , callProcess

43+ , overCreateProcess

44− , callCommand

44+ , proc

45+ , readCreateProcessWithExitCode

46+ , readProcessAndLogOutput

47+ , readProcessAndLogStderr

45 , reconstructCommand

48 , reconstructCommand

49+ , setCwd

50+ , setDelegateCtlc

51+ , setEnvOverride

52+ , shell

46 ) where

53 ) where

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

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

lib/cliapp/src/Obelisk/CliApp/Demo.hs−1

@@ -8,7 +8,6 @@ import Control.Monad.Fail

8import Control.Monad.IO.Class

9import Data.Semigroup ((<>))

10import qualified Data.Text as T

11−import System.Process (proc)

13import Control.Monad.Catch (MonadMask)

12import Control.Monad.Catch (MonadMask)

lib/cliapp/src/Obelisk/CliApp/Process.hs+81−34

@@ -9,17 +9,24 @@

9-- | An extension of `System.Process` that integrates with logging (`Obelisk.CLI.Logging`)

10-- and is thus spinner friendly.

11module Obelisk.CliApp.Process

12+ ( AsProcessFailure (..)

12− ( ProcessFailure (..)

13+ , ProcessFailure (..)

13− , AsProcessFailure (..)

14+ , ProcessSpec (..)

14− , readProcessAndLogStderr

15+ , callCommand

15− , readProcessAndLogOutput

16+ , callProcess

16− , readCreateProcessWithExitCode

17 , callProcessAndLogOutput

18 , createProcess

19 , createProcess_

20− , callProcess

20+ , overCreateProcess

21− , callCommand

21+ , proc

22+ , readCreateProcessWithExitCode

23+ , readProcessAndLogOutput

24+ , readProcessAndLogStderr

22 , reconstructCommand

25 , reconstructCommand

26+ , setCwd

27+ , setDelegateCtlc

28+ , setEnvOverride

29+ , shell

23 ) where

30 ) where

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

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

@@ -30,24 +37,50 @@ import Control.Lens (Prism', review)

30import qualified Data.ByteString as BS

37import qualified Data.ByteString as BS

31import qualified Data.ByteString.Char8 as BSC

38import qualified Data.ByteString.Char8 as BSC

32import Data.Function (fix)

39import Data.Function (fix)

40+import Data.Map (Map)

41+import qualified Data.Map as Map

33import Data.Monoid ((<>))

42import Data.Monoid ((<>))

34import Data.Text (Text)

43import Data.Text (Text)

35import qualified Data.Text as T

44import qualified Data.Text as T

36import qualified Data.Text.Encoding as T

45import qualified Data.Text.Encoding as T

37import Data.Text.Encoding.Error (lenientDecode)

46import Data.Text.Encoding.Error (lenientDecode)

47+import System.Environment (getEnvironment)

38import System.Exit (ExitCode (..))

48import System.Exit (ExitCode (..))

39import System.IO (Handle)

49import System.IO (Handle)

40import System.IO.Streams (InputStream, handleToInputStream)

50import System.IO.Streams (InputStream, handleToInputStream)

41import qualified System.IO.Streams as Streams

51import qualified System.IO.Streams as Streams

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

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

43−import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), cmdspec, std_err, std_out,

53+import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out, waitForProcess)

44− waitForProcess)

45import qualified System.Process as Process

54import qualified System.Process as Process

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

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

48import Obelisk.CliApp.Logging (putLog, putLogRaw)

57import Obelisk.CliApp.Logging (putLog, putLogRaw)

49import Obelisk.CliApp.Types (CliLog, CliThrow)

58import Obelisk.CliApp.Types (CliLog, CliThrow)

60+data ProcessSpec = ProcessSpec

61+ { _processSpec_createProcess :: !CreateProcess

62+ , _processSpec_overrideEnv :: !(Maybe (Map String String -> Map String String))

63+ }

64+

65+proc :: FilePath -> [String] -> ProcessSpec

66+proc cmd args = ProcessSpec (Process.proc cmd args) Nothing

67+

68+shell :: String -> ProcessSpec

69+shell cmd = ProcessSpec (Process.shell cmd) Nothing

70+

71+setEnvOverride :: (Map String String -> Map String String) -> ProcessSpec -> ProcessSpec

72+setEnvOverride f p = p { _processSpec_overrideEnv = Just f }

73+

74+overCreateProcess :: (CreateProcess -> CreateProcess) -> ProcessSpec -> ProcessSpec

75+overCreateProcess f (ProcessSpec p x) = ProcessSpec (f p) x

76+

77+setDelegateCtlc :: Bool -> ProcessSpec -> ProcessSpec

78+setDelegateCtlc b = overCreateProcess (\p -> p { Process.delegate_ctlc = b })

79+

80+setCwd :: Maybe FilePath -> ProcessSpec -> ProcessSpec

81+setCwd fp = overCreateProcess (\p -> p { Process.cwd = fp })

82+

83+

51-- TODO put back in `Obelisk.CliApp.Process` and use prisms for extensible exceptions

84-- TODO put back in `Obelisk.CliApp.Process` and use prisms for extensible exceptions

52data ProcessFailure = ProcessFailure Process.CmdSpec Int -- exit code

85data ProcessFailure = ProcessFailure Process.CmdSpec Int -- exit code

53 deriving Show

86 deriving Show

@@ -62,7 +95,7 @@ instance AsProcessFailure ProcessFailure where

63readProcessAndLogStderr

96readProcessAndLogStderr

64 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

97 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

65− => Severity -> CreateProcess -> m Text

98+ => Severity -> ProcessSpec -> m Text

66readProcessAndLogStderr sev process = do

99readProcessAndLogStderr sev process = do

67 (out, _err) <- withProcess process $ \_out err -> do

100 (out, _err) <- withProcess process $ \_out err -> do

68 streamToLog =<< liftIO (streamHandle sev err)

101 streamToLog =<< liftIO (streamHandle sev err)

@@ -70,9 +103,10 @@ readProcessAndLogStderr sev process = do

103

71readCreateProcessWithExitCode

104readCreateProcessWithExitCode

72 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

105 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

73− => CreateProcess -> m (ExitCode, String, String)

106+ => ProcessSpec -> m (ExitCode, String, String)

74−readCreateProcessWithExitCode process = do

107+readCreateProcessWithExitCode procSpec = do

108+ process <- mkCreateProcess procSpec

75− putLog Debug $ "Creating process: " <> reconstructCommand (cmdspec process)

109+ putLog Debug $ "Creating process: " <> reconstructProcSpec procSpec

76 liftIO $ Process.readCreateProcessWithExitCode process ""

110 liftIO $ Process.readCreateProcessWithExitCode process ""

111

78-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

112-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

@@ -84,10 +118,10 @@ readCreateProcessWithExitCode process = do

84-- `callProcessAndLogOutput (Debug, Debug)`.

118-- `callProcessAndLogOutput (Debug, Debug)`.

85readProcessAndLogOutput

119readProcessAndLogOutput

86 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

120 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

87− => (Severity, Severity) -> CreateProcess -> m Text

121+ => (Severity, Severity) -> ProcessSpec -> m Text

88readProcessAndLogOutput (sev_out, sev_err) process = do

122readProcessAndLogOutput (sev_out, sev_err) process = do

89− (_, Just out, Just err, p) <- createProcess $ process

123+ (_, Just out, Just err, p) <- createProcess $ overCreateProcess

90− { std_out = CreatePipe , std_err = CreatePipe }

124+ (\p -> p { std_out = CreatePipe , std_err = CreatePipe }) process

125

92 -- TODO interleave stdout and stderr in log correctly

126 -- TODO interleave stdout and stderr in log correctly

93 streamToLog =<< liftIO (streamHandle sev_err err)

127 streamToLog =<< liftIO (streamHandle sev_err err)

@@ -96,9 +130,9 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

130

97 liftIO (waitForProcess p) >>= \case

131 liftIO (waitForProcess p) >>= \case

98 ExitSuccess -> pure outText

132 ExitSuccess -> pure outText

99− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (cmdspec process) code

133+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

100

134

101−-- | Like `System.Process.callProcess` but logs the combined output (stdout and stderr)

135+-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

102-- with the corresponding severity.

136-- with the corresponding severity.

103--

137--

104-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

138-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

@@ -106,9 +140,8 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

106-- which case it is advisable to call it with a non-Error severity for stderr, like

140-- which case it is advisable to call it with a non-Error severity for stderr, like

107-- `callProcessAndLogOutput (Debug, Debug)`.

141-- `callProcessAndLogOutput (Debug, Debug)`.

108callProcessAndLogOutput

142callProcessAndLogOutput

109−

110 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

143 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

111− => (Severity, Severity) -> CreateProcess -> m ()

144+ => (Severity, Severity) -> ProcessSpec -> m ()

112callProcessAndLogOutput (sev_out, sev_err) process =

145callProcessAndLogOutput (sev_out, sev_err) process =

113 void $ withProcess process $ \out err -> do

146 void $ withProcess process $ \out err -> do

114 stream <- liftIO $ join $ combineStream

147 stream <- liftIO $ join $ combineStream

@@ -118,21 +151,31 @@ callProcessAndLogOutput (sev_out, sev_err) process =

118 where

151 where

119 combineStream s1 s2 = concurrentMerge [s1, s2]

152 combineStream s1 s2 = concurrentMerge [s1, s2]

120

153

121−-- | Like `System.Process.createProcess` but also logs (debug) the process being run

154+-- | Like 'System.Process.createProcess' but also logs (debug) the process being run

122createProcess

155createProcess

123 :: (MonadIO m, CliLog m)

156 :: (MonadIO m, CliLog m)

124− => CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

157+ => ProcessSpec -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

125−createProcess p = do

158+createProcess procSpec = do

159+ p <- mkCreateProcess procSpec

126− putLog Debug $ "Creating process: " <> reconstructCommand (cmdspec p)

160+ putLog Debug $ "Creating process: " <> reconstructProcSpec procSpec

127 liftIO $ Process.createProcess p

161 liftIO $ Process.createProcess p

128

162

129-- | Like `System.Process.createProcess_` but also logs (debug) the process being run

163-- | Like `System.Process.createProcess_` but also logs (debug) the process being run

130createProcess_

164createProcess_

131 :: (MonadIO m, CliLog m)

165 :: (MonadIO m, CliLog m)

132− => String -> CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

166+ => String -> ProcessSpec -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

133−createProcess_ name p = do

167+createProcess_ name procSpec = do

168+ p <- mkCreateProcess procSpec

134− putLog Debug $ "Creating process " <> T.pack name <> ": " <> reconstructCommand (cmdspec p)

169+ putLog Debug $ "Creating process " <> T.pack name <> ": " <> reconstructProcSpec procSpec

135− liftIO $ Process.createProcess p

170+ liftIO $ Process.createProcess_ name p

171+

172+mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

173+mkCreateProcess (ProcessSpec p override') = do

174+ case override' of

175+ Nothing -> pure p

176+ Just override -> do

177+ procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

178+ pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

136

179

137-- | Like `System.Process.callProcess` but also logs (debug) the process being run

180-- | Like `System.Process.callProcess` but also logs (debug) the process being run

138callProcess

181callProcess

@@ -152,17 +195,17 @@ callCommand cmd = do

152

195

153withProcess

196withProcess

154 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

197 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

155− => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

198+ => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

156withProcess process f = do -- TODO: Use bracket.

199withProcess process f = do -- TODO: Use bracket.

157 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

200 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

158− (_, Just out, Just err, p) <- createProcess $ process

201+ (_, Just out, Just err, p) <- createProcess $ overCreateProcess

159− { std_out = CreatePipe , std_err = CreatePipe }

202+ (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

160

203

161 f out err -- Pass the handles to the passed function

204 f out err -- Pass the handles to the passed function

162

205

163 liftIO (waitForProcess p) >>= \case

206 liftIO (waitForProcess p) >>= \case

164 ExitSuccess -> return (out, err)

207 ExitSuccess -> return (out, err)

165− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (cmdspec process) code

208+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

166

209

167-- Create an input stream from the file handle, associating each item with the given severity.

210-- Create an input stream from the file handle, associating each item with the given severity.

168streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

211streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

@@ -179,8 +222,12 @@ streamToLog stream = fix $ \loop -> do

179

222

180-- | Pretty print a 'CmdSpec'

223-- | Pretty print a 'CmdSpec'

181reconstructCommand :: Process.CmdSpec -> Text

224reconstructCommand :: Process.CmdSpec -> Text

225+reconstructCommand p = case p of

182−reconstructCommand (Process.ShellCommand str) = T.pack str

226+ Process.ShellCommand str -> T.pack str

183−reconstructCommand (Process.RawCommand c as) = processToShellString c as

227+ Process.RawCommand c as -> processToShellString c as

184 where

228 where

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

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

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

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

231+

232+reconstructProcSpec :: ProcessSpec -> Text

233+reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

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

@@ -398,8 +398,8 @@ ob = \case

398 ObCommand_Watch -> inNixShell' $ static runWatch

399 ObCommand_Shell so -> withProjectRoot "." $ \root ->

400 projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

401− ObCommand_Doc shell pkgs -> withProjectRoot "." $ \root ->

401+ ObCommand_Doc shell' pkgs -> withProjectRoot "." $ \root ->

402− projectShell root False shell (Just $ haddockCommand pkgs)

402+ projectShell root False shell' (Just $ haddockCommand pkgs)

403 ObCommand_Internal icmd -> case icmd of

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

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

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

@@ -25,17 +25,17 @@ import Nix.Pretty

25import Nix.String (principledMakeNixStringWithoutContext)

26import Nix.Value

27import System.Directory

28−import System.Environment (getEnvironment)

29import System.FilePath

28import System.FilePath

30import System.IO

29import System.IO

31import System.Posix.Files

30import System.Posix.Files

32−import System.Process (delegate_ctlc, env, proc, cwd)

33import Text.URI (URI)

31import Text.URI (URI)

34import qualified Text.URI as URI

32import qualified Text.URI as URI

35import Text.URI.Lens

33import Text.URI.Lens

37import Obelisk.App (MonadObelisk)

35import Obelisk.App (MonadObelisk)

36+import Obelisk.CliApp (

38−import Obelisk.CliApp (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

37+ Severity (..), callProcessAndLogOutput, failWith, proc, putLog,

38+ setCwd, setDelegateCtlc, setEnvOverride, withSpinner)

39import Obelisk.Command.Nix

40import Obelisk.Command.Project

41import Obelisk.Command.Thunk

@@ -165,8 +165,7 @@ deployPush deployPath getNixBuilders = do

165 putLog Notice $ "Deployed => " <> T.pack route

166 where

167 callProcess' envMap cmd args = do

168− processEnv <- Map.toList . (envMap <>) . Map.fromList <$> liftIO getEnvironment

168+ let p = setEnvOverride (envMap <>) $ setDelegateCtlc True $ proc cmd args

169− let p = (proc cmd args) { delegate_ctlc = True, env = Just processEnv }

170 callProcessAndLogOutput (Notice, Notice) p

169 callProcessAndLogOutput (Notice, Notice) p

171

170

172deployUpdate :: MonadObelisk m => FilePath -> m ()

171deployUpdate :: MonadObelisk m => FilePath -> m ()

@@ -275,7 +274,7 @@ instance ToJSON KeytoolConfig

275createKeystore :: MonadObelisk m => FilePath -> KeytoolConfig -> m ()

274createKeystore :: MonadObelisk m => FilePath -> KeytoolConfig -> m ()

276createKeystore root config = do

275createKeystore root config = do

277 let expr = "with (import " <> toImplDir root <> ").reflex-platform.nixpkgs; pkgs.mkShell { buildInputs = [ pkgs.jdk ]; }"

276 let expr = "with (import " <> toImplDir root <> ").reflex-platform.nixpkgs; pkgs.mkShell { buildInputs = [ pkgs.jdk ]; }"

278− callProcessAndLogOutput (Notice,Notice) $ (proc "nix-shell" ["default.nix", "-E" , expr, "--run" , keytoolCmd]) { cwd = Just root }

277+ callProcessAndLogOutput (Notice,Notice) $ setCwd (Just root) $ proc "nix-shell" ["default.nix", "-E" , expr, "--run" , keytoolCmd]

279 where

278 where

280 keytoolCmd = processToShellString "keytool"

279 keytoolCmd = processToShellString "keytool"

281 [ "-genkeypair", "-noprompt"

280 [ "-genkeypair", "-noprompt"

lib/command/src/Obelisk/Command/Nix.hs−1

@@ -37,7 +37,6 @@ import Data.List (intercalate)

37import Data.Maybe

38import Data.Monoid ((<>))

39import qualified Data.Text as T

40−import System.Process (proc)

42import Obelisk.App (MonadObelisk)

41import Obelisk.App (MonadObelisk)

43import Obelisk.CliApp

42import Obelisk.CliApp

lib/command/src/Obelisk/Command/Project.hs+2−8

@@ -30,7 +30,7 @@ import System.IO.Temp

30import System.IO.Unsafe (unsafePerformIO)

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

32import System.Posix.Files

33−import System.Process (CreateProcess, cwd, proc, waitForProcess, delegate_ctlc)

33+import System.Process (waitForProcess)

34import System.Which (staticWhich)

36import GitHub.Data.GitData (Branch)

@@ -248,7 +248,7 @@ projectShell root isPure shellName command = do

248 let nixPath = $(staticWhich "nix")

249 nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ proc nixPath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

250 nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

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

251+ (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd (Just root) $ proc "nix-shell" $

252 [ "default.nix"] <>

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

254 [ "-A"

@@ -263,9 +263,3 @@ projectShell root isPure shellName command = do

263 c

264 ]

265 void $ liftIO $ waitForProcess ph

266−

267−setCtlc :: CreateProcess -> CreateProcess

268−setCtlc cfg = cfg { delegate_ctlc = True }

269−

270−setCwd :: Maybe FilePath -> CreateProcess -> CreateProcess

271−setCwd fp cfg = cfg { cwd = fp }

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

@@ -31,7 +31,6 @@ import Language.Haskell.Extension

31import Network.Socket hiding (Debug)

32import System.Directory

33import System.FilePath

34−import System.Process (proc)

35import System.IO.Temp (withSystemTempDirectory)

34import System.IO.Temp (withSystemTempDirectory)

36import System.Which (staticWhich)

35import System.Which (staticWhich)

37import Data.ByteString (ByteString)

36import Data.ByteString (ByteString)

@@ -39,7 +38,7 @@ import Data.ByteString (ByteString)

39import Obelisk.App (MonadObelisk, ObeliskT)

38import Obelisk.App (MonadObelisk, ObeliskT)

40import Obelisk.CliApp

39import Obelisk.CliApp

41 ( CliT (..), HasCliConfig, Severity (..)

40 ( CliT (..), HasCliConfig, Severity (..)

42− , callCommand, failWith, getCliConfig, putLog

41+ , callCommand, failWith, getCliConfig, putLog, proc

43 , readProcessAndLogStderr, runCli)

42 , readProcessAndLogStderr, runCli)

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

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

lib/command/src/Obelisk/Command/Thunk.hs−1

@@ -71,7 +71,6 @@ import System.FilePath

71import System.IO.Error

72import System.IO.Temp

73import System.Posix (getSymbolicLinkStatus, modificationTime)

74−import System.Process (proc)

75import Text.URI

74import Text.URI

77import Obelisk.App (MonadObelisk)

76import Obelisk.App (MonadObelisk)

lib/command/src/Obelisk/Command/Utils.hs+8−10

@@ -23,7 +23,6 @@ import Data.Void (Void)

23import System.Directory (canonicalizePath)

24import System.Environment (getExecutablePath)

25import System.Exit (ExitCode)

26−import qualified System.Process as P

27import Text.Megaparsec as MP

26import Text.Megaparsec as MP

28import Text.Megaparsec.Char as MP

27import Text.Megaparsec.Char as MP

@@ -61,11 +60,10 @@ initGit repo = do

61 git ["add", "."]

60 git ["add", "."]

62 git ["commit", "-m", "Initial commit."]

61 git ["commit", "-m", "Initial commit."]

64−gitProcNoRepo :: [String] -> P.CreateProcess

63+gitProcNoRepo :: [String] -> ProcessSpec

65−gitProcNoRepo = P.proc "git"

64+gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc "git" args

67−-- TODO: GIT_TERMINAL_PROMPT=0

68−gitProc :: FilePath -> [String] -> P.CreateProcess

66+gitProc :: FilePath -> [String] -> ProcessSpec

69gitProc repo = gitProcNoRepo . runGitInDir

67gitProc repo = gitProcNoRepo . runGitInDir

70 where

68 where

71 runGitInDir args' = case filter (not . null) args' of

69 runGitInDir args' = case filter (not . null) args' of

@@ -73,9 +71,9 @@ gitProc repo = gitProcNoRepo . runGitInDir

73 args -> ["-C", repo] <> args

71 args -> ["-C", repo] <> args

75-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

73-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

76−copyDir :: FilePath -> FilePath -> P.CreateProcess

74+copyDir :: FilePath -> FilePath -> ProcessSpec

77copyDir src dest =

75copyDir src dest =

78− (P.proc "cp" ["-a", ".", dest]) { P.cwd = Just src } -- TODO: This will break if dest is relative since we change cwd

76+ setCwd (Just src) $ proc "cp" ["-a", ".", dest] -- TODO: This will break if dest is relative since we change cwd

80readGitProcess :: MonadObelisk m => FilePath -> [String] -> m Text

78readGitProcess :: MonadObelisk m => FilePath -> [String] -> m Text

81readGitProcess repo = readProcessAndLogOutput (Debug, Notice) . gitProc repo

79readGitProcess repo = readProcessAndLogOutput (Debug, Notice) . gitProc repo

@@ -88,15 +86,15 @@ processToShellString cmd args = unwords $ map quoteAndEscape (cmd : args)

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

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

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

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

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

89+runProc :: MonadObelisk m => ProcessSpec -> m ()

92runProc = callProcessAndLogOutput (Notice, Error)

90runProc = callProcessAndLogOutput (Notice, Error)

94-- | Like runProc, but all output goes to Debug logging level

92-- | Like runProc, but all output goes to Debug logging level

95−runProcSilently :: MonadObelisk m => P.CreateProcess -> m ()

93+runProcSilently :: MonadObelisk m => ProcessSpec -> m ()

96runProcSilently = callProcessAndLogOutput (Debug, Debug)

94runProcSilently = callProcessAndLogOutput (Debug, Debug)

98-- | A simpler wrapper for CliApp's readProcessAndLogStderr with sensible defaults.

96-- | A simpler wrapper for CliApp's readProcessAndLogStderr with sensible defaults.

99−readProc :: MonadObelisk m => P.CreateProcess -> m Text

97+readProc :: MonadObelisk m => ProcessSpec -> m Text

100readProc = readProcessAndLogOutput (Debug, Error)

98readProc = readProcessAndLogOutput (Debug, Error)

101

102tshow :: Show a => a -> Text

100tshow :: Show a => a -> Text

lib/command/src/Obelisk/Command/VmBuilder.hs−1

@@ -18,7 +18,6 @@ import System.Directory (createDirectoryIfMissing)

18import System.Exit (ExitCode(..))

19import System.FilePath ((<.>), (</>))

20import qualified System.Info

21−import System.Process (proc)

23import Obelisk.App (MonadObelisk, getObeliskUserStateDir)

22import Obelisk.App (MonadObelisk, getObeliskUserStateDir)

24import Obelisk.CliApp

23import Obelisk.CliApp