{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Prelude
( withSystemTempDir
, withKeepSystemTempDir
, sinkProcessStderrStdout
, sinkProcessStdout
, logProcessStderrStdout
, readProcessNull
, withProcessContext
, stripCR
, prompt
, promptPassword
, promptBool
, stackProgName
, FirstTrue (..)
, fromFirstTrue
, defaultFirstTrue
, FirstFalse (..)
, fromFirstFalse
, defaultFirstFalse
, writeBinaryFileAtomic
, module X
) where
import RIO as X
import RIO.File as X hiding (writeBinaryFileAtomic)
import Data.Conduit as X (ConduitM, runConduit, (.|))
import Path as X (Abs, Dir, File, Path, Rel,
toFilePath)
import Pantry as X hiding (Package (..), loadSnapshot)
import Data.Monoid as X (First (..), Any (..), Sum (..), Endo (..))
import qualified Path.IO
import System.IO.Echo (withoutInputEcho)
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Conduit.Process.Typed (withLoggedProcess_, createSource, byteStringInput)
import RIO.Process (HasProcessContext (..), ProcessContext, setStdin, closed, getStderr, getStdout, proc, withProcessWait_, setStdout, setStderr, ProcessConfig, readProcess_, workingDirL, waitExitCode)
import qualified Data.Text.IO as T
import qualified RIO.Text as T
withSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
withSystemTempDir :: String -> (Path Abs Dir -> m a) -> m a
withSystemTempDir String
str Path Abs Dir -> m a
inner = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> String -> (Path Abs Dir -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (Path Abs Dir -> m a) -> m a
Path.IO.withSystemTempDir String
str ((Path Abs Dir -> IO a) -> IO a) -> (Path Abs Dir -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (Path Abs Dir -> m a) -> Path Abs Dir -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> m a
inner
withKeepSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
withKeepSystemTempDir :: String -> (Path Abs Dir -> m a) -> m a
withKeepSystemTempDir String
str Path Abs Dir -> m a
inner = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
Path Abs Dir
path <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.IO.getTempDir
Path Abs Dir
dir <- Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> String -> m (Path Abs Dir)
Path.IO.createTempDir Path Abs Dir
path String
str
m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> m a
inner Path Abs Dir
dir
sinkProcessStderrStdout
:: forall e o env. (HasProcessContext env, HasLogFunc env, HasCallStack)
=> String
-> [String]
-> ConduitM ByteString Void (RIO env) e
-> ConduitM ByteString Void (RIO env) o
-> RIO env (e,o)
sinkProcessStderrStdout :: String
-> [String]
-> ConduitM ByteString Void (RIO env) e
-> ConduitM ByteString Void (RIO env) o
-> RIO env (e, o)
sinkProcessStderrStdout String
name [String]
args ConduitM ByteString Void (RIO env) e
sinkStderr ConduitM ByteString Void (RIO env) o
sinkStdout =
String
-> [String]
-> (ProcessConfig () () () -> RIO env (e, o))
-> RIO env (e, o)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
name [String]
args ((ProcessConfig () () () -> RIO env (e, o)) -> RIO env (e, o))
-> (ProcessConfig () () () -> RIO env (e, o)) -> RIO env (e, o)
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc0 -> do
let pc :: ProcessConfig
()
(ConduitM i ByteString (RIO env) ())
(ConduitM i ByteString (RIO env) ())
pc = StreamSpec 'STOutput (ConduitM i ByteString (RIO env) ())
-> ProcessConfig () () (ConduitM i ByteString (RIO env) ())
-> ProcessConfig
()
(ConduitM i ByteString (RIO env) ())
(ConduitM i ByteString (RIO env) ())
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput (ConduitM i ByteString (RIO env) ())
forall (m :: * -> *) i.
MonadIO m =>
StreamSpec 'STOutput (ConduitM i ByteString m ())
createSource
(ProcessConfig () () (ConduitM i ByteString (RIO env) ())
-> ProcessConfig
()
(ConduitM i ByteString (RIO env) ())
(ConduitM i ByteString (RIO env) ()))
-> ProcessConfig () () (ConduitM i ByteString (RIO env) ())
-> ProcessConfig
()
(ConduitM i ByteString (RIO env) ())
(ConduitM i ByteString (RIO env) ())
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput (ConduitM i ByteString (RIO env) ())
-> ProcessConfig () () ()
-> ProcessConfig () () (ConduitM i ByteString (RIO env) ())
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (ConduitM i ByteString (RIO env) ())
forall (m :: * -> *) i.
MonadIO m =>
StreamSpec 'STOutput (ConduitM i ByteString m ())
createSource
(ProcessConfig () () ()
-> ProcessConfig () () (ConduitM i ByteString (RIO env) ()))
-> ProcessConfig () () ()
-> ProcessConfig () () (ConduitM i ByteString (RIO env) ())
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
"")
ProcessConfig () () ()
pc0
ProcessConfig
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env (e, o))
-> RIO env (e, o)
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait_ ProcessConfig
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
forall i i.
ProcessConfig
()
(ConduitM i ByteString (RIO env) ())
(ConduitM i ByteString (RIO env) ())
pc ((Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env (e, o))
-> RIO env (e, o))
-> (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env (e, o))
-> RIO env (e, o)
forall a b. (a -> b) -> a -> b
$ \Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ->
(ConduitT () Void (RIO env) e -> RIO env e
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) e
-> ConduitT () Void (RIO env) e
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) e
sinkStderr) RIO env e -> RIO env o -> RIO env (e, o)
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m (a, b)
`concurrently`
ConduitT () Void (RIO env) o -> RIO env o
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) o
-> ConduitT () Void (RIO env) o
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) o
sinkStdout)) RIO env (e, o) -> RIO env ExitCode -> RIO env (e, o)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p
sinkProcessStdout
:: (HasProcessContext env, HasLogFunc env, HasCallStack)
=> String
-> [String]
-> ConduitM ByteString Void (RIO env) a
-> RIO env a
sinkProcessStdout :: String
-> [String] -> ConduitM ByteString Void (RIO env) a -> RIO env a
sinkProcessStdout String
name [String]
args ConduitM ByteString Void (RIO env) a
sinkStdout =
String
-> [String] -> (ProcessConfig () () () -> RIO env a) -> RIO env a
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
name [String]
args ((ProcessConfig () () () -> RIO env a) -> RIO env a)
-> (ProcessConfig () () () -> RIO env a) -> RIO env a
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc ->
ProcessConfig () () ()
-> (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env a)
-> RIO env a
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored a.
MonadUnliftIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process
stdin (ConduitM () ByteString m ()) (ConduitM () ByteString m ())
-> m a)
-> m a
withLoggedProcess_ (StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed ProcessConfig () () ()
pc) ((Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env a)
-> RIO env a)
-> (Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env a)
-> RIO env a
forall a b. (a -> b) -> a -> b
$ \Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p -> Concurrently (RIO env) a -> RIO env a
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently
(Concurrently (RIO env) a -> RIO env a)
-> Concurrently (RIO env) a -> RIO env a
forall a b. (a -> b) -> a -> b
$ RIO env () -> Concurrently (RIO env) ()
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (ConduitT () Void (RIO env) () -> RIO env ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (RIO env) () -> RIO env ())
-> ConduitT () Void (RIO env) () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) ()
-> ConduitT () Void (RIO env) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull)
Concurrently (RIO env) ()
-> Concurrently (RIO env) a -> Concurrently (RIO env) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RIO env a -> Concurrently (RIO env) a
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (ConduitT () Void (RIO env) a -> RIO env a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (RIO env) a -> RIO env a)
-> ConduitT () Void (RIO env) a -> RIO env a
forall a b. (a -> b) -> a -> b
$ Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
()
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) a
-> ConduitT () Void (RIO env) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) a
sinkStdout)
logProcessStderrStdout
:: (HasCallStack, HasProcessContext env, HasLogFunc env)
=> ProcessConfig stdin stdoutIgnored stderrIgnored
-> RIO env ()
logProcessStderrStdout :: ProcessConfig stdin stdoutIgnored stderrIgnored -> RIO env ()
logProcessStderrStdout ProcessConfig stdin stdoutIgnored stderrIgnored
pc = ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env ())
-> RIO env ()
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored a.
MonadUnliftIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> (Process
stdin (ConduitM () ByteString m ()) (ConduitM () ByteString m ())
-> m a)
-> m a
withLoggedProcess_ ProcessConfig stdin stdoutIgnored stderrIgnored
pc ((Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env ())
-> RIO env ())
-> (Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> RIO env ())
-> RIO env ()
forall a b. (a -> b) -> a -> b
$ \Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ->
let logLines :: ConduitM ByteString c (RIO env) ()
logLines = ConduitT ByteString ByteString (RIO env) ()
forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m ()
CB.lines ConduitT ByteString ByteString (RIO env) ()
-> ConduitM ByteString c (RIO env) ()
-> ConduitM ByteString c (RIO env) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ByteString -> RIO env ()) -> ConduitM ByteString c (RIO env) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
CL.mapM_ (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ())
-> (ByteString -> Utf8Builder) -> ByteString -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Utf8Builder
displayBytesUtf8)
in Concurrently (RIO env) () -> RIO env ()
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently
(Concurrently (RIO env) () -> RIO env ())
-> Concurrently (RIO env) () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ RIO env () -> Concurrently (RIO env) ()
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (ConduitT () Void (RIO env) () -> RIO env ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (RIO env) () -> RIO env ())
-> ConduitT () Void (RIO env) () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) ()
-> ConduitT () Void (RIO env) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) ()
forall c. ConduitM ByteString c (RIO env) ()
logLines)
Concurrently (RIO env) ()
-> Concurrently (RIO env) () -> Concurrently (RIO env) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RIO env () -> Concurrently (RIO env) ()
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (ConduitT () Void (RIO env) () -> RIO env ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (RIO env) () -> RIO env ())
-> ConduitT () Void (RIO env) () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
-> ConduitM () ByteString (RIO env) ()
forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
stdin
(ConduitM () ByteString (RIO env) ())
(ConduitM () ByteString (RIO env) ())
p ConduitM () ByteString (RIO env) ()
-> ConduitM ByteString Void (RIO env) ()
-> ConduitT () Void (RIO env) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void (RIO env) ()
forall c. ConduitM ByteString c (RIO env) ()
logLines)
readProcessNull :: (HasProcessContext env, HasLogFunc env, HasCallStack)
=> String
-> [String]
-> RIO env ()
readProcessNull :: String -> [String] -> RIO env ()
readProcessNull String
name [String]
args =
RIO env (ByteString, ByteString) -> RIO env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO env (ByteString, ByteString) -> RIO env ())
-> RIO env (ByteString, ByteString) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
name [String]
args ProcessConfig () () () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
withProcessContext :: HasProcessContext env => ProcessContext -> RIO env a -> RIO env a
withProcessContext :: ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
pcNew RIO env a
inner = do
ProcessContext
pcOld <- Getting ProcessContext env ProcessContext -> RIO env ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
let pcNew' :: ProcessContext
pcNew' = ASetter ProcessContext ProcessContext (Maybe String) (Maybe String)
-> Maybe String -> ProcessContext -> ProcessContext
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ProcessContext ProcessContext (Maybe String) (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL (Getting (Maybe String) ProcessContext (Maybe String)
-> ProcessContext -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) ProcessContext (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL ProcessContext
pcOld) ProcessContext
pcNew
(env -> env) -> RIO env a -> RIO env a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter env env ProcessContext ProcessContext
-> ProcessContext -> env -> env
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter env env ProcessContext ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
pcNew') RIO env a
inner
stripCR :: Text -> Text
stripCR :: Text -> Text
stripCR = Text -> Text -> Text
T.dropSuffix Text
"\r"
prompt :: MonadIO m => Text -> m Text
prompt :: Text -> m Text
prompt Text
txt = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStr Text
txt
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
IO Text
T.getLine
promptPassword :: MonadIO m => Text -> m Text
promptPassword :: Text -> m Text
promptPassword Text
txt = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStr Text
txt
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
Text
password <- IO Text -> IO Text
forall a. IO a -> IO a
withoutInputEcho IO Text
T.getLine
Text -> IO ()
T.putStrLn Text
""
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
password
promptBool :: MonadIO m => Text -> m Bool
promptBool :: Text -> m Bool
promptBool Text
txt = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Text
input <- Text -> IO Text
forall (m :: * -> *). MonadIO m => Text -> m Text
prompt Text
txt
case Text
input of
Text
"y" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Text
"n" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Text
_ -> do
Text -> IO ()
T.putStrLn Text
"Please press either 'y' or 'n', and then enter."
Text -> IO Bool
forall (m :: * -> *). MonadIO m => Text -> m Bool
promptBool Text
txt
stackProgName :: String
stackProgName :: String
stackProgName = String
"stack"
newtype FirstTrue = FirstTrue { FirstTrue -> Maybe Bool
getFirstTrue :: Maybe Bool }
deriving (Int -> FirstTrue -> ShowS
[FirstTrue] -> ShowS
FirstTrue -> String
(Int -> FirstTrue -> ShowS)
-> (FirstTrue -> String)
-> ([FirstTrue] -> ShowS)
-> Show FirstTrue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirstTrue] -> ShowS
$cshowList :: [FirstTrue] -> ShowS
show :: FirstTrue -> String
$cshow :: FirstTrue -> String
showsPrec :: Int -> FirstTrue -> ShowS
$cshowsPrec :: Int -> FirstTrue -> ShowS
Show, FirstTrue -> FirstTrue -> Bool
(FirstTrue -> FirstTrue -> Bool)
-> (FirstTrue -> FirstTrue -> Bool) -> Eq FirstTrue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirstTrue -> FirstTrue -> Bool
$c/= :: FirstTrue -> FirstTrue -> Bool
== :: FirstTrue -> FirstTrue -> Bool
$c== :: FirstTrue -> FirstTrue -> Bool
Eq, Eq FirstTrue
Eq FirstTrue
-> (FirstTrue -> FirstTrue -> Ordering)
-> (FirstTrue -> FirstTrue -> Bool)
-> (FirstTrue -> FirstTrue -> Bool)
-> (FirstTrue -> FirstTrue -> Bool)
-> (FirstTrue -> FirstTrue -> Bool)
-> (FirstTrue -> FirstTrue -> FirstTrue)
-> (FirstTrue -> FirstTrue -> FirstTrue)
-> Ord FirstTrue
FirstTrue -> FirstTrue -> Bool
FirstTrue -> FirstTrue -> Ordering
FirstTrue -> FirstTrue -> FirstTrue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FirstTrue -> FirstTrue -> FirstTrue
$cmin :: FirstTrue -> FirstTrue -> FirstTrue
max :: FirstTrue -> FirstTrue -> FirstTrue
$cmax :: FirstTrue -> FirstTrue -> FirstTrue
>= :: FirstTrue -> FirstTrue -> Bool
$c>= :: FirstTrue -> FirstTrue -> Bool
> :: FirstTrue -> FirstTrue -> Bool
$c> :: FirstTrue -> FirstTrue -> Bool
<= :: FirstTrue -> FirstTrue -> Bool
$c<= :: FirstTrue -> FirstTrue -> Bool
< :: FirstTrue -> FirstTrue -> Bool
$c< :: FirstTrue -> FirstTrue -> Bool
compare :: FirstTrue -> FirstTrue -> Ordering
$ccompare :: FirstTrue -> FirstTrue -> Ordering
$cp1Ord :: Eq FirstTrue
Ord)
instance Semigroup FirstTrue where
FirstTrue (Just Bool
x) <> :: FirstTrue -> FirstTrue -> FirstTrue
<> FirstTrue
_ = Maybe Bool -> FirstTrue
FirstTrue (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x)
FirstTrue Maybe Bool
Nothing <> FirstTrue
x = FirstTrue
x
instance Monoid FirstTrue where
mempty :: FirstTrue
mempty = Maybe Bool -> FirstTrue
FirstTrue Maybe Bool
forall a. Maybe a
Nothing
mappend :: FirstTrue -> FirstTrue -> FirstTrue
mappend = FirstTrue -> FirstTrue -> FirstTrue
forall a. Semigroup a => a -> a -> a
(<>)
fromFirstTrue :: FirstTrue -> Bool
fromFirstTrue :: FirstTrue -> Bool
fromFirstTrue = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool)
-> (FirstTrue -> Maybe Bool) -> FirstTrue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstTrue -> Maybe Bool
getFirstTrue
defaultFirstTrue :: (a -> FirstTrue) -> Bool
defaultFirstTrue :: (a -> FirstTrue) -> Bool
defaultFirstTrue a -> FirstTrue
_ = Bool
True
newtype FirstFalse = FirstFalse { FirstFalse -> Maybe Bool
getFirstFalse :: Maybe Bool }
deriving (Int -> FirstFalse -> ShowS
[FirstFalse] -> ShowS
FirstFalse -> String
(Int -> FirstFalse -> ShowS)
-> (FirstFalse -> String)
-> ([FirstFalse] -> ShowS)
-> Show FirstFalse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirstFalse] -> ShowS
$cshowList :: [FirstFalse] -> ShowS
show :: FirstFalse -> String
$cshow :: FirstFalse -> String
showsPrec :: Int -> FirstFalse -> ShowS
$cshowsPrec :: Int -> FirstFalse -> ShowS
Show, FirstFalse -> FirstFalse -> Bool
(FirstFalse -> FirstFalse -> Bool)
-> (FirstFalse -> FirstFalse -> Bool) -> Eq FirstFalse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirstFalse -> FirstFalse -> Bool
$c/= :: FirstFalse -> FirstFalse -> Bool
== :: FirstFalse -> FirstFalse -> Bool
$c== :: FirstFalse -> FirstFalse -> Bool
Eq, Eq FirstFalse
Eq FirstFalse
-> (FirstFalse -> FirstFalse -> Ordering)
-> (FirstFalse -> FirstFalse -> Bool)
-> (FirstFalse -> FirstFalse -> Bool)
-> (FirstFalse -> FirstFalse -> Bool)
-> (FirstFalse -> FirstFalse -> Bool)
-> (FirstFalse -> FirstFalse -> FirstFalse)
-> (FirstFalse -> FirstFalse -> FirstFalse)
-> Ord FirstFalse
FirstFalse -> FirstFalse -> Bool
FirstFalse -> FirstFalse -> Ordering
FirstFalse -> FirstFalse -> FirstFalse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FirstFalse -> FirstFalse -> FirstFalse
$cmin :: FirstFalse -> FirstFalse -> FirstFalse
max :: FirstFalse -> FirstFalse -> FirstFalse
$cmax :: FirstFalse -> FirstFalse -> FirstFalse
>= :: FirstFalse -> FirstFalse -> Bool
$c>= :: FirstFalse -> FirstFalse -> Bool
> :: FirstFalse -> FirstFalse -> Bool
$c> :: FirstFalse -> FirstFalse -> Bool
<= :: FirstFalse -> FirstFalse -> Bool
$c<= :: FirstFalse -> FirstFalse -> Bool
< :: FirstFalse -> FirstFalse -> Bool
$c< :: FirstFalse -> FirstFalse -> Bool
compare :: FirstFalse -> FirstFalse -> Ordering
$ccompare :: FirstFalse -> FirstFalse -> Ordering
$cp1Ord :: Eq FirstFalse
Ord)
instance Semigroup FirstFalse where
FirstFalse (Just Bool
x) <> :: FirstFalse -> FirstFalse -> FirstFalse
<> FirstFalse
_ = Maybe Bool -> FirstFalse
FirstFalse (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x)
FirstFalse Maybe Bool
Nothing <> FirstFalse
x = FirstFalse
x
instance Monoid FirstFalse where
mempty :: FirstFalse
mempty = Maybe Bool -> FirstFalse
FirstFalse Maybe Bool
forall a. Maybe a
Nothing
mappend :: FirstFalse -> FirstFalse -> FirstFalse
mappend = FirstFalse -> FirstFalse -> FirstFalse
forall a. Semigroup a => a -> a -> a
(<>)
fromFirstFalse :: FirstFalse -> Bool
fromFirstFalse :: FirstFalse -> Bool
fromFirstFalse = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (FirstFalse -> Maybe Bool) -> FirstFalse -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstFalse -> Maybe Bool
getFirstFalse
defaultFirstFalse :: (a -> FirstFalse) -> Bool
defaultFirstFalse :: (a -> FirstFalse) -> Bool
defaultFirstFalse a -> FirstFalse
_ = Bool
False
writeBinaryFileAtomic :: MonadIO m => Path absrel File -> Builder -> m ()
writeBinaryFileAtomic :: Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path absrel File
fp Builder
builder =
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m r) -> m r
withBinaryFileAtomic (Path absrel File -> String
forall b t. Path b t -> String
toFilePath Path absrel File
fp) IOMode
WriteMode (Handle -> Builder -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Builder -> m ()
`hPutBuilder` Builder
builder)