{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cradle.Output
  ( runAndGetOutput,
    Output (..),
    StdoutUntrimmed (..),
    StdoutTrimmed (..),
    StdoutRaw (..),
    StderrRaw (..),
  )
where

import Control.Arrow ((>>>))
import Cradle.ProcessConfiguration
import Data.ByteString (ByteString)
import Data.Proxy
import Data.String.Conversions (cs)
import Data.Text (Text, strip)
import GHC.Generics (Generic)
import System.Exit
import Prelude hiding (dropWhile)

runAndGetOutput :: forall output. (Output output) => ProcessConfiguration -> IO output
runAndGetOutput :: forall output. Output output => ProcessConfiguration -> IO output
runAndGetOutput ProcessConfiguration
config = ProcessResult -> output
forall output. Output output => ProcessResult -> output
extractOutput (ProcessResult -> output) -> IO ProcessResult -> IO output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfiguration -> IO ProcessResult
runProcess (Proxy output -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy output
forall {k} (t :: k). Proxy t
Proxy :: Proxy output) ProcessConfiguration
config)

class Output output where
  configure :: Proxy output -> ProcessConfiguration -> ProcessConfiguration
  extractOutput :: ProcessResult -> output

instance Output () where
  configure :: Proxy () -> ProcessConfiguration -> ProcessConfiguration
configure Proxy ()
Proxy = ProcessConfiguration -> ProcessConfiguration
forall a. a -> a
id
  extractOutput :: ProcessResult -> ()
extractOutput = () -> ProcessResult -> ()
forall a b. a -> b -> a
const ()

instance
  (Output a, Output b) =>
  Output (a, b)
  where
  configure :: Proxy (a, b) -> ProcessConfiguration -> ProcessConfiguration
configure Proxy (a, b)
Proxy =
    Proxy a -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy b -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
  extractOutput :: ProcessResult -> (a, b)
extractOutput ProcessResult
result =
    ( ProcessResult -> a
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> b
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
    )

instance
  (Output a, Output b, Output c) =>
  Output (a, b, c)
  where
  configure :: Proxy (a, b, c) -> ProcessConfiguration -> ProcessConfiguration
configure Proxy (a, b, c)
Proxy =
    Proxy a -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy b -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy c -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
  extractOutput :: ProcessResult -> (a, b, c)
extractOutput ProcessResult
result =
    ( ProcessResult -> a
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> b
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> c
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
    )

instance
  (Output a, Output b, Output c, Output d) =>
  Output (a, b, c, d)
  where
  configure :: Proxy (a, b, c, d) -> ProcessConfiguration -> ProcessConfiguration
configure Proxy (a, b, c, d)
Proxy =
    Proxy a -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy b -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy c -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy d -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
  extractOutput :: ProcessResult -> (a, b, c, d)
extractOutput ProcessResult
result =
    ( ProcessResult -> a
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> b
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> c
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> d
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
    )

instance
  (Output a, Output b, Output c, Output d, Output e) =>
  Output (a, b, c, d, e)
  where
  configure :: Proxy (a, b, c, d, e)
-> ProcessConfiguration -> ProcessConfiguration
configure Proxy (a, b, c, d, e)
Proxy =
    Proxy a -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy b -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy c -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy d -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy e -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy e
forall {k} (t :: k). Proxy t
Proxy :: Proxy e)
  extractOutput :: ProcessResult -> (a, b, c, d, e)
extractOutput ProcessResult
result =
    ( ProcessResult -> a
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> b
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> c
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> d
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> e
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
    )

instance
  (Output a, Output b, Output c, Output d, Output e, Output f) =>
  Output (a, b, c, d, e, f)
  where
  configure :: Proxy (a, b, c, d, e, f)
-> ProcessConfiguration -> ProcessConfiguration
configure Proxy (a, b, c, d, e, f)
Proxy =
    Proxy a -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy b -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy c -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy c
forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy d -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy e -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy e
forall {k} (t :: k). Proxy t
Proxy :: Proxy e)
      (ProcessConfiguration -> ProcessConfiguration)
-> (ProcessConfiguration -> ProcessConfiguration)
-> ProcessConfiguration
-> ProcessConfiguration
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Proxy f -> ProcessConfiguration -> ProcessConfiguration
forall output.
Output output =>
Proxy output -> ProcessConfiguration -> ProcessConfiguration
configure (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)
  extractOutput :: ProcessResult -> (a, b, c, d, e, f)
extractOutput ProcessResult
result =
    ( ProcessResult -> a
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> b
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> c
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> d
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> e
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result,
      ProcessResult -> f
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
    )

newtype StdoutUntrimmed = StdoutUntrimmed
  { StdoutUntrimmed -> Text
fromStdoutUntrimmed :: Text
  }
  deriving stock (Int -> StdoutUntrimmed -> ShowS
[StdoutUntrimmed] -> ShowS
StdoutUntrimmed -> String
(Int -> StdoutUntrimmed -> ShowS)
-> (StdoutUntrimmed -> String)
-> ([StdoutUntrimmed] -> ShowS)
-> Show StdoutUntrimmed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdoutUntrimmed -> ShowS
showsPrec :: Int -> StdoutUntrimmed -> ShowS
$cshow :: StdoutUntrimmed -> String
show :: StdoutUntrimmed -> String
$cshowList :: [StdoutUntrimmed] -> ShowS
showList :: [StdoutUntrimmed] -> ShowS
Show, StdoutUntrimmed -> StdoutUntrimmed -> Bool
(StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> (StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> Eq StdoutUntrimmed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
== :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
$c/= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
/= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
Eq, Eq StdoutUntrimmed
Eq StdoutUntrimmed =>
(StdoutUntrimmed -> StdoutUntrimmed -> Ordering)
-> (StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> (StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> (StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> (StdoutUntrimmed -> StdoutUntrimmed -> Bool)
-> (StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed)
-> (StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed)
-> Ord StdoutUntrimmed
StdoutUntrimmed -> StdoutUntrimmed -> Bool
StdoutUntrimmed -> StdoutUntrimmed -> Ordering
StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StdoutUntrimmed -> StdoutUntrimmed -> Ordering
compare :: StdoutUntrimmed -> StdoutUntrimmed -> Ordering
$c< :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
< :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
$c<= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
<= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
$c> :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
> :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
$c>= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
>= :: StdoutUntrimmed -> StdoutUntrimmed -> Bool
$cmax :: StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed
max :: StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed
$cmin :: StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed
min :: StdoutUntrimmed -> StdoutUntrimmed -> StdoutUntrimmed
Ord, (forall x. StdoutUntrimmed -> Rep StdoutUntrimmed x)
-> (forall x. Rep StdoutUntrimmed x -> StdoutUntrimmed)
-> Generic StdoutUntrimmed
forall x. Rep StdoutUntrimmed x -> StdoutUntrimmed
forall x. StdoutUntrimmed -> Rep StdoutUntrimmed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StdoutUntrimmed -> Rep StdoutUntrimmed x
from :: forall x. StdoutUntrimmed -> Rep StdoutUntrimmed x
$cto :: forall x. Rep StdoutUntrimmed x -> StdoutUntrimmed
to :: forall x. Rep StdoutUntrimmed x -> StdoutUntrimmed
Generic)

instance Output StdoutUntrimmed where
  configure :: Proxy StdoutUntrimmed
-> ProcessConfiguration -> ProcessConfiguration
configure Proxy StdoutUntrimmed
Proxy ProcessConfiguration
config =
    ProcessConfiguration
config {stdoutConfig = (stdoutConfig config) {capture = True}}
  extractOutput :: ProcessResult -> StdoutUntrimmed
extractOutput ProcessResult
result =
    let StdoutRaw ByteString
output = ProcessResult -> StdoutRaw
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
     in Text -> StdoutUntrimmed
StdoutUntrimmed (Text -> StdoutUntrimmed) -> Text -> StdoutUntrimmed
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
output

newtype StdoutTrimmed = StdoutTrimmed
  { StdoutTrimmed -> Text
fromStdoutTrimmed :: Text
  }
  deriving stock (Int -> StdoutTrimmed -> ShowS
[StdoutTrimmed] -> ShowS
StdoutTrimmed -> String
(Int -> StdoutTrimmed -> ShowS)
-> (StdoutTrimmed -> String)
-> ([StdoutTrimmed] -> ShowS)
-> Show StdoutTrimmed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdoutTrimmed -> ShowS
showsPrec :: Int -> StdoutTrimmed -> ShowS
$cshow :: StdoutTrimmed -> String
show :: StdoutTrimmed -> String
$cshowList :: [StdoutTrimmed] -> ShowS
showList :: [StdoutTrimmed] -> ShowS
Show, StdoutTrimmed -> StdoutTrimmed -> Bool
(StdoutTrimmed -> StdoutTrimmed -> Bool)
-> (StdoutTrimmed -> StdoutTrimmed -> Bool) -> Eq StdoutTrimmed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdoutTrimmed -> StdoutTrimmed -> Bool
== :: StdoutTrimmed -> StdoutTrimmed -> Bool
$c/= :: StdoutTrimmed -> StdoutTrimmed -> Bool
/= :: StdoutTrimmed -> StdoutTrimmed -> Bool
Eq, Eq StdoutTrimmed
Eq StdoutTrimmed =>
(StdoutTrimmed -> StdoutTrimmed -> Ordering)
-> (StdoutTrimmed -> StdoutTrimmed -> Bool)
-> (StdoutTrimmed -> StdoutTrimmed -> Bool)
-> (StdoutTrimmed -> StdoutTrimmed -> Bool)
-> (StdoutTrimmed -> StdoutTrimmed -> Bool)
-> (StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed)
-> (StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed)
-> Ord StdoutTrimmed
StdoutTrimmed -> StdoutTrimmed -> Bool
StdoutTrimmed -> StdoutTrimmed -> Ordering
StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StdoutTrimmed -> StdoutTrimmed -> Ordering
compare :: StdoutTrimmed -> StdoutTrimmed -> Ordering
$c< :: StdoutTrimmed -> StdoutTrimmed -> Bool
< :: StdoutTrimmed -> StdoutTrimmed -> Bool
$c<= :: StdoutTrimmed -> StdoutTrimmed -> Bool
<= :: StdoutTrimmed -> StdoutTrimmed -> Bool
$c> :: StdoutTrimmed -> StdoutTrimmed -> Bool
> :: StdoutTrimmed -> StdoutTrimmed -> Bool
$c>= :: StdoutTrimmed -> StdoutTrimmed -> Bool
>= :: StdoutTrimmed -> StdoutTrimmed -> Bool
$cmax :: StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed
max :: StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed
$cmin :: StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed
min :: StdoutTrimmed -> StdoutTrimmed -> StdoutTrimmed
Ord, (forall x. StdoutTrimmed -> Rep StdoutTrimmed x)
-> (forall x. Rep StdoutTrimmed x -> StdoutTrimmed)
-> Generic StdoutTrimmed
forall x. Rep StdoutTrimmed x -> StdoutTrimmed
forall x. StdoutTrimmed -> Rep StdoutTrimmed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StdoutTrimmed -> Rep StdoutTrimmed x
from :: forall x. StdoutTrimmed -> Rep StdoutTrimmed x
$cto :: forall x. Rep StdoutTrimmed x -> StdoutTrimmed
to :: forall x. Rep StdoutTrimmed x -> StdoutTrimmed
Generic)

instance Output StdoutTrimmed where
  configure :: Proxy StdoutTrimmed -> ProcessConfiguration -> ProcessConfiguration
configure Proxy StdoutTrimmed
Proxy ProcessConfiguration
config =
    ProcessConfiguration
config {stdoutConfig = (stdoutConfig config) {capture = True}}
  extractOutput :: ProcessResult -> StdoutTrimmed
extractOutput ProcessResult
result =
    let StdoutRaw ByteString
output = ProcessResult -> StdoutRaw
forall output. Output output => ProcessResult -> output
extractOutput ProcessResult
result
     in Text -> StdoutTrimmed
StdoutTrimmed (Text -> StdoutTrimmed) -> Text -> StdoutTrimmed
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
output

newtype StdoutRaw = StdoutRaw
  { StdoutRaw -> ByteString
fromStdoutRaw :: ByteString
  }
  deriving stock (Int -> StdoutRaw -> ShowS
[StdoutRaw] -> ShowS
StdoutRaw -> String
(Int -> StdoutRaw -> ShowS)
-> (StdoutRaw -> String)
-> ([StdoutRaw] -> ShowS)
-> Show StdoutRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdoutRaw -> ShowS
showsPrec :: Int -> StdoutRaw -> ShowS
$cshow :: StdoutRaw -> String
show :: StdoutRaw -> String
$cshowList :: [StdoutRaw] -> ShowS
showList :: [StdoutRaw] -> ShowS
Show, StdoutRaw -> StdoutRaw -> Bool
(StdoutRaw -> StdoutRaw -> Bool)
-> (StdoutRaw -> StdoutRaw -> Bool) -> Eq StdoutRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdoutRaw -> StdoutRaw -> Bool
== :: StdoutRaw -> StdoutRaw -> Bool
$c/= :: StdoutRaw -> StdoutRaw -> Bool
/= :: StdoutRaw -> StdoutRaw -> Bool
Eq, Eq StdoutRaw
Eq StdoutRaw =>
(StdoutRaw -> StdoutRaw -> Ordering)
-> (StdoutRaw -> StdoutRaw -> Bool)
-> (StdoutRaw -> StdoutRaw -> Bool)
-> (StdoutRaw -> StdoutRaw -> Bool)
-> (StdoutRaw -> StdoutRaw -> Bool)
-> (StdoutRaw -> StdoutRaw -> StdoutRaw)
-> (StdoutRaw -> StdoutRaw -> StdoutRaw)
-> Ord StdoutRaw
StdoutRaw -> StdoutRaw -> Bool
StdoutRaw -> StdoutRaw -> Ordering
StdoutRaw -> StdoutRaw -> StdoutRaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StdoutRaw -> StdoutRaw -> Ordering
compare :: StdoutRaw -> StdoutRaw -> Ordering
$c< :: StdoutRaw -> StdoutRaw -> Bool
< :: StdoutRaw -> StdoutRaw -> Bool
$c<= :: StdoutRaw -> StdoutRaw -> Bool
<= :: StdoutRaw -> StdoutRaw -> Bool
$c> :: StdoutRaw -> StdoutRaw -> Bool
> :: StdoutRaw -> StdoutRaw -> Bool
$c>= :: StdoutRaw -> StdoutRaw -> Bool
>= :: StdoutRaw -> StdoutRaw -> Bool
$cmax :: StdoutRaw -> StdoutRaw -> StdoutRaw
max :: StdoutRaw -> StdoutRaw -> StdoutRaw
$cmin :: StdoutRaw -> StdoutRaw -> StdoutRaw
min :: StdoutRaw -> StdoutRaw -> StdoutRaw
Ord, (forall x. StdoutRaw -> Rep StdoutRaw x)
-> (forall x. Rep StdoutRaw x -> StdoutRaw) -> Generic StdoutRaw
forall x. Rep StdoutRaw x -> StdoutRaw
forall x. StdoutRaw -> Rep StdoutRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StdoutRaw -> Rep StdoutRaw x
from :: forall x. StdoutRaw -> Rep StdoutRaw x
$cto :: forall x. Rep StdoutRaw x -> StdoutRaw
to :: forall x. Rep StdoutRaw x -> StdoutRaw
Generic)

instance Output StdoutRaw where
  configure :: Proxy StdoutRaw -> ProcessConfiguration -> ProcessConfiguration
configure Proxy StdoutRaw
Proxy ProcessConfiguration
config =
    ProcessConfiguration
config {stdoutConfig = (stdoutConfig config) {capture = True}}
  extractOutput :: ProcessResult -> StdoutRaw
extractOutput ProcessResult
result =
    case ProcessResult -> Maybe ByteString
stdout ProcessResult
result of
      Maybe ByteString
Nothing -> String -> StdoutRaw
forall a. HasCallStack => String -> a
error String
"impossible: stdout not captured"
      Just ByteString
output -> ByteString -> StdoutRaw
StdoutRaw ByteString
output

newtype StderrRaw = StderrRaw
  { StderrRaw -> ByteString
fromStderr :: ByteString
  }
  deriving stock (Int -> StderrRaw -> ShowS
[StderrRaw] -> ShowS
StderrRaw -> String
(Int -> StderrRaw -> ShowS)
-> (StderrRaw -> String)
-> ([StderrRaw] -> ShowS)
-> Show StderrRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StderrRaw -> ShowS
showsPrec :: Int -> StderrRaw -> ShowS
$cshow :: StderrRaw -> String
show :: StderrRaw -> String
$cshowList :: [StderrRaw] -> ShowS
showList :: [StderrRaw] -> ShowS
Show, StderrRaw -> StderrRaw -> Bool
(StderrRaw -> StderrRaw -> Bool)
-> (StderrRaw -> StderrRaw -> Bool) -> Eq StderrRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StderrRaw -> StderrRaw -> Bool
== :: StderrRaw -> StderrRaw -> Bool
$c/= :: StderrRaw -> StderrRaw -> Bool
/= :: StderrRaw -> StderrRaw -> Bool
Eq, Eq StderrRaw
Eq StderrRaw =>
(StderrRaw -> StderrRaw -> Ordering)
-> (StderrRaw -> StderrRaw -> Bool)
-> (StderrRaw -> StderrRaw -> Bool)
-> (StderrRaw -> StderrRaw -> Bool)
-> (StderrRaw -> StderrRaw -> Bool)
-> (StderrRaw -> StderrRaw -> StderrRaw)
-> (StderrRaw -> StderrRaw -> StderrRaw)
-> Ord StderrRaw
StderrRaw -> StderrRaw -> Bool
StderrRaw -> StderrRaw -> Ordering
StderrRaw -> StderrRaw -> StderrRaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StderrRaw -> StderrRaw -> Ordering
compare :: StderrRaw -> StderrRaw -> Ordering
$c< :: StderrRaw -> StderrRaw -> Bool
< :: StderrRaw -> StderrRaw -> Bool
$c<= :: StderrRaw -> StderrRaw -> Bool
<= :: StderrRaw -> StderrRaw -> Bool
$c> :: StderrRaw -> StderrRaw -> Bool
> :: StderrRaw -> StderrRaw -> Bool
$c>= :: StderrRaw -> StderrRaw -> Bool
>= :: StderrRaw -> StderrRaw -> Bool
$cmax :: StderrRaw -> StderrRaw -> StderrRaw
max :: StderrRaw -> StderrRaw -> StderrRaw
$cmin :: StderrRaw -> StderrRaw -> StderrRaw
min :: StderrRaw -> StderrRaw -> StderrRaw
Ord, (forall x. StderrRaw -> Rep StderrRaw x)
-> (forall x. Rep StderrRaw x -> StderrRaw) -> Generic StderrRaw
forall x. Rep StderrRaw x -> StderrRaw
forall x. StderrRaw -> Rep StderrRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StderrRaw -> Rep StderrRaw x
from :: forall x. StderrRaw -> Rep StderrRaw x
$cto :: forall x. Rep StderrRaw x -> StderrRaw
to :: forall x. Rep StderrRaw x -> StderrRaw
Generic)

instance Output StderrRaw where
  configure :: Proxy StderrRaw -> ProcessConfiguration -> ProcessConfiguration
configure Proxy StderrRaw
Proxy ProcessConfiguration
config =
    ProcessConfiguration
config {stderrConfig = (stderrConfig config) {capture = True}}
  extractOutput :: ProcessResult -> StderrRaw
extractOutput ProcessResult
result =
    case ProcessResult -> Maybe ByteString
stderr ProcessResult
result of
      Maybe ByteString
Nothing -> String -> StderrRaw
forall a. HasCallStack => String -> a
error String
"impossible: stderr not captured"
      Just ByteString
stderr -> ByteString -> StderrRaw
StderrRaw ByteString
stderr

instance Output ExitCode where
  configure :: Proxy ExitCode -> ProcessConfiguration -> ProcessConfiguration
configure Proxy ExitCode
Proxy ProcessConfiguration
config = ProcessConfiguration
config {throwOnError = False}
  extractOutput :: ProcessResult -> ExitCode
extractOutput = ProcessResult -> ExitCode
exitCode