{-# 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

-- | Path version

withSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
withSystemTempDir :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Path Abs Dir -> m a) -> m a
withSystemTempDir String
str Path Abs Dir -> m a
inner = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (Path Abs Dir -> m a) -> m a
Path.IO.withSystemTempDir String
str forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> m a
inner

-- | Like `withSystemTempDir`, but the temporary directory is not deleted.

withKeepSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
withKeepSystemTempDir :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Path Abs Dir -> m a) -> m a
withKeepSystemTempDir String
str Path Abs Dir -> m a
inner = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  Path Abs Dir
path <- forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
Path.IO.getTempDir
  Path Abs Dir
dir <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> String -> m (Path Abs Dir)
Path.IO.createTempDir Path Abs Dir
path String
str
  forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> m a
inner Path Abs Dir
dir

-- | Consume the stdout and stderr of a process feeding strict 'ByteString's to the consumers.

--

-- Throws a 'ReadProcessException' if unsuccessful in launching, or 'ExitCodeException' if the process itself fails.

sinkProcessStderrStdout
  :: forall e o env. (HasProcessContext env, HasLogFunc env, HasCallStack)
  => String -- ^ Command

  -> [String] -- ^ Command line arguments

  -> ConduitM ByteString Void (RIO env) e -- ^ Sink for stderr

  -> ConduitM ByteString Void (RIO env) o -- ^ Sink for stdout

  -> RIO env (e,o)
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
name [String]
args ConduitM ByteString Void (RIO env) e
sinkStderr ConduitM ByteString Void (RIO env) o
sinkStdout =
  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 forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc0 -> do
    let pc :: ProcessConfig
  ()
  (ConduitM i ByteString (RIO env) ())
  (ConduitM i ByteString (RIO env) ())
pc = forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (m :: * -> *) i.
MonadIO m =>
StreamSpec 'STOutput (ConduitM i ByteString m ())
createSource
           forall a b. (a -> b) -> a -> b
$ forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr forall (m :: * -> *) i.
MonadIO m =>
StreamSpec 'STOutput (ConduitM i ByteString m ())
createSource
           -- Don't use closed, since that can break ./configure scripts

           -- See https://github.com/commercialhaskell/stack/pull/4722

           forall a b. (a -> b) -> a -> b
$ forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
"")
             ProcessConfig () () ()
pc0
    forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait_ forall {i} {i}.
ProcessConfig
  ()
  (ConduitM i ByteString (RIO env) ())
  (ConduitM i ByteString (RIO env) ())
pc forall a b. (a -> b) -> a -> b
$ \Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p ->
      (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString Void (RIO env) e
sinkStderr) forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m (a, b)
`concurrently`
      forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString Void (RIO env) o
sinkStdout)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p

-- | Consume the stdout of a process feeding strict 'ByteString's to a consumer.

-- If the process fails, spits out stdout and stderr as error log

-- level. Should not be used for long-running processes or ones with

-- lots of output; for that use 'sinkProcessStderrStdout'.

--

-- Throws a 'ReadProcessException' if unsuccessful.

sinkProcessStdout
    :: (HasProcessContext env, HasLogFunc env, HasCallStack)
    => String -- ^ Command

    -> [String] -- ^ Command line arguments

    -> ConduitM ByteString Void (RIO env) a -- ^ Sink for stdout

    -> RIO env a
sinkProcessStdout :: forall env a.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String
-> [String] -> ConduitM ByteString Void (RIO env) a -> RIO env a
sinkProcessStdout String
name [String]
args ConduitM ByteString Void (RIO env) a
sinkStdout =
  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 forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc ->
  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_ (forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed ProcessConfig () () ()
pc) forall a b. (a -> b) -> a -> b
$ \Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p -> forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull)
   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
  ()
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM ByteString Void (RIO env) a
sinkStdout)

logProcessStderrStdout
    :: (HasCallStack, HasProcessContext env, HasLogFunc env)
    => ProcessConfig stdin stdoutIgnored stderrIgnored
    -> RIO env ()
logProcessStderrStdout :: forall env stdin stdoutIgnored stderrIgnored.
(HasCallStack, HasProcessContext env, HasLogFunc env) =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> RIO env ()
logProcessStderrStdout ProcessConfig stdin stdoutIgnored stderrIgnored
pc = 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 forall a b. (a -> b) -> a -> b
$ \Process
  stdin
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p ->
    let logLines :: ConduitT ByteString c (RIO env) ()
logLines = forall (m :: * -> *).
Monad m =>
ConduitT ByteString ByteString m ()
CB.lines forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
CL.mapM_ (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Utf8Builder
displayBytesUtf8)
     in forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently
            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process
  stdin
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {c}. ConduitT ByteString c (RIO env) ()
logLines)
           forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr. Process stdin stdout stderr -> stderr
getStderr Process
  stdin
  (ConduitM () ByteString (RIO env) ())
  (ConduitM () ByteString (RIO env) ())
p forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {c}. ConduitT ByteString c (RIO env) ()
logLines)

-- | Read from the process, ignoring any output.

--

-- Throws a 'ReadProcessException' exception if the process fails.

readProcessNull :: (HasProcessContext env, HasLogFunc env, HasCallStack)
                => String -- ^ Command

                -> [String] -- ^ Command line arguments

                -> RIO env ()
readProcessNull :: forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String -> [String] -> RIO env ()
readProcessNull String
name [String]
args =
  -- We want the output to appear in any exceptions, so we capture and drop it

  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_

-- | Use the new 'ProcessContext', but retain the working directory

-- from the parent environment.

withProcessContext :: HasProcessContext env => ProcessContext -> RIO env a -> RIO env a
withProcessContext :: forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
pcNew RIO env a
inner = do
  ProcessContext
pcOld <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  let pcNew' :: ProcessContext
pcNew' = forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL ProcessContext
pcOld) ProcessContext
pcNew
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
pcNew') RIO env a
inner

-- | Remove a trailing carriage return if present

stripCR :: Text -> Text
stripCR :: Text -> Text
stripCR = Text -> Text -> Text
T.dropSuffix Text
"\r"

-- | Prompt the user by sending text to stdout, and taking a line of

-- input from stdin.

prompt :: MonadIO m => Text -> m Text
prompt :: forall (m :: * -> *). MonadIO m => Text -> m Text
prompt Text
txt = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Text -> IO ()
T.putStr Text
txt
  forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
  IO Text
T.getLine

-- | Prompt the user by sending text to stdout, and collecting a line

-- of input from stdin. While taking input from stdin, input echoing is

-- disabled, to hide passwords.

--

-- Based on code from cabal-install, Distribution.Client.Upload

promptPassword :: MonadIO m => Text -> m Text
promptPassword :: forall (m :: * -> *). MonadIO m => Text -> m Text
promptPassword Text
txt = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Text -> IO ()
T.putStr Text
txt
  forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
  -- Save/restore the terminal echoing status (no echoing for entering

  -- the password).

  Text
password <- forall a. IO a -> IO a
withoutInputEcho IO Text
T.getLine
  -- Since the user's newline is not echoed, one needs to be inserted.

  Text -> IO ()
T.putStrLn Text
""
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
password

-- | Prompt the user by sending text to stdout, and collecting a line of

-- input from stdin. If something other than "y" or "n" is entered, then

-- print a message indicating that "y" or "n" is expected, and ask

-- again.

promptBool :: MonadIO m => Text -> m Bool
promptBool :: forall (m :: * -> *). MonadIO m => Text -> m Bool
promptBool Text
txt = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Text
input <- forall (m :: * -> *). MonadIO m => Text -> m Text
prompt Text
txt
  case Text
input of
    Text
"y" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Text
"n" -> 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."
      forall (m :: * -> *). MonadIO m => Text -> m Bool
promptBool Text
txt

-- | Name of the 'stack' program.

--

-- NOTE: Should be defined in "Stack.Constants", but not doing so due to the

-- GHC stage restrictions.

stackProgName :: String
stackProgName :: String
stackProgName = String
"stack"

-- | Like @First Bool@, but the default is @True@.

newtype FirstTrue = FirstTrue { FirstTrue -> Maybe Bool
getFirstTrue :: Maybe Bool }
  deriving (Int -> FirstTrue -> ShowS
[FirstTrue] -> ShowS
FirstTrue -> String
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
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
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
Ord)
instance Semigroup FirstTrue where
  FirstTrue (Just Bool
x) <> :: FirstTrue -> FirstTrue -> FirstTrue
<> FirstTrue
_ = Maybe Bool -> FirstTrue
FirstTrue (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 forall a. Maybe a
Nothing
  mappend :: FirstTrue -> FirstTrue -> FirstTrue
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Get the 'Bool', defaulting to 'True'

fromFirstTrue :: FirstTrue -> Bool
fromFirstTrue :: FirstTrue -> Bool
fromFirstTrue = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstTrue -> Maybe Bool
getFirstTrue

-- | Helper for filling in default values

defaultFirstTrue :: (a -> FirstTrue) -> Bool
defaultFirstTrue :: forall a. (a -> FirstTrue) -> Bool
defaultFirstTrue a -> FirstTrue
_ = Bool
True

-- | Like @First Bool@, but the default is @False@.

newtype FirstFalse = FirstFalse { FirstFalse -> Maybe Bool
getFirstFalse :: Maybe Bool }
  deriving (Int -> FirstFalse -> ShowS
[FirstFalse] -> ShowS
FirstFalse -> String
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
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
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
Ord)
instance Semigroup FirstFalse where
  FirstFalse (Just Bool
x) <> :: FirstFalse -> FirstFalse -> FirstFalse
<> FirstFalse
_ = Maybe Bool -> FirstFalse
FirstFalse (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 forall a. Maybe a
Nothing
  mappend :: FirstFalse -> FirstFalse -> FirstFalse
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Get the 'Bool', defaulting to 'False'

fromFirstFalse :: FirstFalse -> Bool
fromFirstFalse :: FirstFalse -> Bool
fromFirstFalse = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstFalse -> Maybe Bool
getFirstFalse

-- | Helper for filling in default values

defaultFirstFalse :: (a -> FirstFalse) -> Bool
defaultFirstFalse :: forall a. (a -> FirstFalse) -> Bool
defaultFirstFalse a -> FirstFalse
_ = Bool
False

-- | Write a @Builder@ to a file and atomically rename.

writeBinaryFileAtomic :: MonadIO m => Path absrel File -> Builder -> m ()
writeBinaryFileAtomic :: forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path absrel File
fp Builder
builder =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) r.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m r) -> m r
withBinaryFileAtomic (forall b t. Path b t -> String
toFilePath Path absrel File
fp) IOMode
WriteMode (forall (m :: * -> *). MonadIO m => Handle -> Builder -> m ()
`hPutBuilder` Builder
builder)