{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      : Common.Utils
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Exports common `IO` functions.
module Common.IO
  ( sh,
    sh_,
    trySh,
    tryShAndReturnStdErr,
    tryShExitCode,
    tryTimeSh,
  )
where

import Common.RefinedUtils
import Common.Utils
import qualified Control.Exception as Ex
import Data.Functor (($>))
import qualified Data.Text as T
import qualified System.Clock as C
import qualified System.Exit as Exit
import qualified System.Process as P

-- | Returns the result of running a shell command given by
-- 'T.Text' on 'FilePath'.
sh :: T.Text -> Maybe FilePath -> IO T.Text
sh :: Text -> Maybe FilePath -> IO Text
sh cmd :: Text
cmd fp :: Maybe FilePath
fp = FilePath -> Text
T.pack (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateProcess -> FilePath -> IO FilePath
P.readCreateProcess CreateProcess
proc ""
  where
    proc :: CreateProcess
proc = (FilePath -> CreateProcess
P.shell (Text -> FilePath
T.unpack Text
cmd)) {cwd :: Maybe FilePath
P.cwd = Maybe FilePath
fp}

-- | Version of 'sh' that ignores the return value.
sh_ :: T.Text -> Maybe FilePath -> IO ()
sh_ :: Text -> Maybe FilePath -> IO ()
sh_ cmd :: Text
cmd fp :: Maybe FilePath
fp = CreateProcess -> FilePath -> IO FilePath
P.readCreateProcess CreateProcess
proc "" IO FilePath -> () -> IO ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
  where
    proc :: CreateProcess
proc = (FilePath -> CreateProcess
P.shell (Text -> FilePath
T.unpack Text
cmd)) {cwd :: Maybe FilePath
P.cwd = Maybe FilePath
fp}

-- | Version of 'sh' that returns ('Exit.ExitCode', stdout, stderr)
shExitCode :: T.Text -> Maybe FilePath -> IO (Exit.ExitCode, String, String)
shExitCode :: Text -> Maybe FilePath -> IO (ExitCode, FilePath, FilePath)
shExitCode cmd :: Text
cmd path :: Maybe FilePath
path = CreateProcess -> FilePath -> IO (ExitCode, FilePath, FilePath)
P.readCreateProcessWithExitCode CreateProcess
proc ""
  where
    proc :: CreateProcess
proc = (FilePath -> CreateProcess
P.shell (Text -> FilePath
T.unpack Text
cmd)) {cwd :: Maybe FilePath
P.cwd = Maybe FilePath
path}

-- | Attempts to return the result of running a shell command given by
-- 'T.Text' on 'FilePath'.
trySh :: T.Text -> Maybe FilePath -> IO (Either Ex.SomeException T.Text)
trySh :: Text -> Maybe FilePath -> IO (Either SomeException Text)
trySh cmd :: Text
cmd path :: Maybe FilePath
path = IO Text -> IO (Either SomeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
Ex.try (Text -> Maybe FilePath -> IO Text
sh Text
cmd Maybe FilePath
path)

-- | This is an odd function; it returns stderr on both success and failure.
-- Why is this useful? There are some shell commands that set the return code
-- to 0 (success) but also return information we care about as stderr.
-- Performing git push on a branch that is already up-to-date is an example
-- that "succeeds", but the output we care about ("Everything up-to-date") is
-- inexplicably sent to stderr instead of stdout. This function is meant for
-- these situations, where we still want the usual `trySh` semantics, but want
-- to paradoxically return stderr on success.
tryShAndReturnStdErr :: T.Text -> Maybe FilePath -> IO (Either T.Text T.Text)
tryShAndReturnStdErr :: Text -> Maybe FilePath -> IO (Either Text Text)
tryShAndReturnStdErr cmd :: Text
cmd path :: Maybe FilePath
path = do
  (code :: ExitCode
code, _, err :: FilePath
err) <- Text -> Maybe FilePath -> IO (ExitCode, FilePath, FilePath)
shExitCode Text
cmd Maybe FilePath
path
  Either Text Text -> IO (Either Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Text -> IO (Either Text Text))
-> Either Text Text -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ case ExitCode
code of
    Exit.ExitSuccess -> Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (FilePath -> Text
T.pack FilePath
err)
    Exit.ExitFailure _ ->
      Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$
        "Error running `"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.strip (FilePath -> Text
T.pack FilePath
err)

-- | Returns 'Left' stderr if there is a failure, 'Right' stdout otherwise.
tryShExitCode :: T.Text -> Maybe FilePath -> IO (Either T.Text T.Text)
tryShExitCode :: Text -> Maybe FilePath -> IO (Either Text Text)
tryShExitCode cmd :: Text
cmd path :: Maybe FilePath
path = do
  (code :: ExitCode
code, out :: FilePath
out, err :: FilePath
err) <- Text -> Maybe FilePath -> IO (ExitCode, FilePath, FilePath)
shExitCode Text
cmd Maybe FilePath
path
  Either Text Text -> IO (Either Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Text -> IO (Either Text Text))
-> Either Text Text -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ case ExitCode
code of
    Exit.ExitSuccess -> Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (FilePath -> Text
T.pack FilePath
out)
    Exit.ExitFailure _ ->
      Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$
        "Error running `"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.strip (FilePath -> Text
T.pack FilePath
err)

-- | Version of 'tryShExitCode' that also returns (t, stdout/stderr), where
-- /t/ is the time the command took in seconds.
tryTimeSh ::
  T.Text ->
  Maybe FilePath ->
  IO (Either (RNonNegative Int, T.Text) (RNonNegative Int, T.Text))
tryTimeSh :: Text
-> Maybe FilePath
-> IO (Either (RNonNegative Int, Text) (RNonNegative Int, Text))
tryTimeSh cmd :: Text
cmd path :: Maybe FilePath
path = do
  TimeSpec
start <- Clock -> IO TimeSpec
C.getTime Clock
C.Monotonic
  Either Text Text
res <- Text -> Maybe FilePath -> IO (Either Text Text)
tryShExitCode Text
cmd Maybe FilePath
path
  TimeSpec
end <- Clock -> IO TimeSpec
C.getTime Clock
C.Monotonic
  let diff :: RNonNegative Int
diff = TimeSpec -> TimeSpec -> RNonNegative Int
diffTime TimeSpec
start TimeSpec
end
  Either (RNonNegative Int, Text) (RNonNegative Int, Text)
-> IO (Either (RNonNegative Int, Text) (RNonNegative Int, Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (RNonNegative Int, Text) (RNonNegative Int, Text)
 -> IO (Either (RNonNegative Int, Text) (RNonNegative Int, Text)))
-> Either (RNonNegative Int, Text) (RNonNegative Int, Text)
-> IO (Either (RNonNegative Int, Text) (RNonNegative Int, Text))
forall a b. (a -> b) -> a -> b
$ (Text -> (RNonNegative Int, Text))
-> Either Text Text
-> Either (RNonNegative Int, Text) (RNonNegative Int, Text)
forall (f :: * -> * -> *) a b.
Bifunctor f =>
(a -> b) -> f a a -> f b b
monoBimap (RNonNegative Int
diff,) Either Text Text
res