-- Copyright 2019 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Miscellaneous utilities for Cmds.
--
-- "Cmd.Cmd" is forced to be huge, due to circular dependencies, so utilities
-- that don't fall foul of that should generally go in here.
module Cmd.CmdUtil where
import qualified Data.ByteString as ByteString
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.Encoding.Error as Encoding.Error

import qualified System.Exit as Exit

import qualified Util.Processes as Processes
import qualified Cmd.Cmd as Cmd

import           Global


read_process :: FilePath -> [String] -> Cmd.CmdT IO Text
read_process :: FilePath -> [FilePath] -> CmdT IO Text
read_process FilePath
cmd [FilePath]
args = do
    (ExitCode
exit, ByteString
stdout, ByteString
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
Processes.readProcessWithExitCode forall a. Maybe a
Nothing FilePath
cmd [FilePath]
args ByteString
""
    case ExitCode
exit of
        Exit.ExitFailure Int
code -> forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Text
"cmd failed: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
code
            forall a. Semigroup a => a -> a -> a
<> Text
", stderr: " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decode_utf8 ByteString
stderr
        ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decode_utf8 ByteString
stdout

decode_utf8 :: ByteString.ByteString -> Text
decode_utf8 :: ByteString -> Text
decode_utf8 = OnDecodeError -> ByteString -> Text
Encoding.decodeUtf8With OnDecodeError
Encoding.Error.lenientDecode