forked from filipg/gonito
prepare Runner for better running stuff
This commit is contained in:
parent
edf0624b95
commit
dcdf71b5e6
@ -10,6 +10,49 @@ import qualified Data.ByteString as BS
|
|||||||
|
|
||||||
type Channel = TChan (Maybe Text)
|
type Channel = TChan (Maybe Text)
|
||||||
|
|
||||||
|
data RunnerStatus a = RunnerOK a | RunnerError ExitCode
|
||||||
|
|
||||||
|
newtype Runner a = Runner { runRunner :: Channel -> Handler (RunnerStatus a) }
|
||||||
|
|
||||||
|
getChannel :: Runner Channel
|
||||||
|
getChannel = Runner {
|
||||||
|
runRunner = \chan -> return $ RunnerOK chan
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Functor Runner where
|
||||||
|
fmap f runner = Runner {
|
||||||
|
runRunner = \chan -> do
|
||||||
|
s <- (runRunner runner) chan
|
||||||
|
return $ case s of
|
||||||
|
RunnerOK v -> RunnerOK $ f v
|
||||||
|
RunnerError e -> RunnerError e
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Applicative Runner where
|
||||||
|
pure v = Runner {
|
||||||
|
runRunner = \chan -> return $ RunnerOK v
|
||||||
|
}
|
||||||
|
liftA2 f runner1 runner2 = Runner {
|
||||||
|
runRunner = \chan -> do
|
||||||
|
s1 <- (runRunner runner1) chan
|
||||||
|
case s1 of
|
||||||
|
RunnerOK v1 -> do
|
||||||
|
s2 <- (runRunner runner2) chan
|
||||||
|
case s2 of
|
||||||
|
RunnerOK v2 -> return $ RunnerOK $ f v1 v2
|
||||||
|
RunnerError e -> return $ RunnerError e
|
||||||
|
RunnerError e -> return $ RunnerError e
|
||||||
|
}
|
||||||
|
|
||||||
|
run :: Maybe FilePath -> FilePath -> [String] -> Runner ()
|
||||||
|
run workingDir programPath args = Runner {
|
||||||
|
runRunner = \chan -> do
|
||||||
|
(code, _) <- runProgram workingDir programPath args chan
|
||||||
|
case code of
|
||||||
|
ExitSuccess -> return $ RunnerOK ()
|
||||||
|
_ -> return $ RunnerError code
|
||||||
|
}
|
||||||
|
|
||||||
runProgram :: Maybe FilePath -> FilePath -> [String] -> Channel -> Handler (ExitCode, Text)
|
runProgram :: Maybe FilePath -> FilePath -> [String] -> Channel -> Handler (ExitCode, Text)
|
||||||
runProgram workingDir programPath args chan = do
|
runProgram workingDir programPath args chan = do
|
||||||
(_, Just hout, Just herr, pid) <-
|
(_, Just hout, Just herr, pid) <-
|
||||||
|
Loading…
Reference in New Issue
Block a user