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

module Mit.Process where

import qualified Data.Sequence as Seq
import Mit.Prelude
import System.Exit (ExitCode (..), exitWith)

class ProcessOutput a where
  fromProcessOutput :: Seq Text -> Seq Text -> ExitCode -> IO a

instance ProcessOutput () where
  fromProcessOutput :: Seq Text -> Seq Text -> ExitCode -> IO ()
fromProcessOutput Seq Text
_ Seq 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 :: Seq Text -> Seq Text -> ExitCode -> IO Bool
fromProcessOutput Seq Text
_ Seq 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 :: Seq Text -> Seq Text -> ExitCode -> IO Text
fromProcessOutput Seq Text
out Seq 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 Seq Text
out of
      Seq Text
Seq.Empty -> IOError -> IO Text
forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
      Text
line Seq.:<| Seq Text
_ -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
line

instance a ~ Text => ProcessOutput [a] where
  fromProcessOutput :: Seq Text -> Seq Text -> ExitCode -> IO [a]
fromProcessOutput Seq Text
out Seq Text
err ExitCode
code =
    forall a. Foldable Seq => Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList @Seq (Seq a -> [a]) -> IO (Seq a) -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Text -> Seq Text -> ExitCode -> IO (Seq a)
forall a.
ProcessOutput a =>
Seq Text -> Seq Text -> ExitCode -> IO a
fromProcessOutput Seq Text
out Seq Text
err ExitCode
code

instance a ~ ExitCode => ProcessOutput (Either a Text) where
  fromProcessOutput :: Seq Text -> Seq Text -> ExitCode -> IO (Either a Text)
fromProcessOutput Seq Text
out Seq 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 Seq Text
out of
          Seq Text
Seq.Empty -> IOError -> IO (Either a Text)
forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
          Text
line Seq.:<| Seq 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 :: Seq Text -> Seq Text -> ExitCode -> IO (Maybe a)
fromProcessOutput Seq Text
out Seq 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 Seq Text
out of
      Seq Text
Seq.Empty -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      Text
line Seq.:<| Seq Text
_ -> Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
line)

instance a ~ Text => ProcessOutput (Seq a) where
  fromProcessOutput :: Seq Text -> Seq Text -> ExitCode -> IO (Seq a)
fromProcessOutput Seq Text
out Seq 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)
    Seq Text -> IO (Seq Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Text
out