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

module Mit.Process
  ( ProcessOutput (..),
  )
where

import Data.Sequence qualified 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 =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ExitCode
ExitSuccess -> 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (forall a. ExitCode -> IO a
exitWith ExitCode
code)
    case Seq Text
out of
      Seq Text
Seq.Empty -> forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
      Text
line Seq.:<| Seq 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList @Seq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left ExitCode
code)
      ExitCode
ExitSuccess ->
        case Seq Text
out of
          Seq Text
Seq.Empty -> forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
"no stdout")
          Text
line Seq.:<| Seq Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (forall a. ExitCode -> IO a
exitWith ExitCode
code)
    case Seq Text
out of
      Seq Text
Seq.Empty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Text
line Seq.:<| Seq Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
code forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (forall a. ExitCode -> IO a
exitWith ExitCode
code)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Text
out