-- Some ad-hoc process return value overloading, for cleaner syntax

module Mit.Process where

import Mit.Prelude
import System.Exit (ExitCode (..), exitWith)

class ProcessOutput a where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO a

instance ProcessOutput () where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO ()
fromProcessOutput [Text]
_ [Text]
_ ExitCode
code =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
code)

instance ProcessOutput Bool where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO Bool
fromProcessOutput [Text]
_ [Text]
_ = \case
    ExitFailure Int
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ExitCode
ExitSuccess -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

instance ProcessOutput Text where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO Text
fromProcessOutput [Text]
out [Text]
_ ExitCode
code = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
code)
    case [Text]
out of
      [] -> IOError -> IO Text
forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
      Text
line : [Text]
_ -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
line

instance a ~ Text => ProcessOutput [a] where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO [a]
fromProcessOutput [Text]
out [Text]
_ ExitCode
code = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
code)
    [Text] -> IO [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
out

instance a ~ ExitCode => ProcessOutput (Either a Text) where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO (Either a Text)
fromProcessOutput [Text]
out [Text]
_ ExitCode
code =
    case ExitCode
code of
      ExitFailure Int
_ -> Either ExitCode Text -> IO (Either ExitCode Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> Either ExitCode Text
forall a b. a -> Either a b
Left ExitCode
code)
      ExitCode
ExitSuccess ->
        case [Text]
out of
          [] -> IOError -> IO (Either a Text)
forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
          Text
line : [Text]
_ -> Either a Text -> IO (Either a Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either a Text
forall a b. b -> Either a b
Right Text
line)

instance a ~ Text => ProcessOutput (Maybe a) where
  fromProcessOutput :: [Text] -> [Text] -> ExitCode -> IO (Maybe a)
fromProcessOutput [Text]
out [Text]
_ ExitCode
code = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
code)
    Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
out)