Commit 0eed259a authored by Valentin Reis's avatar Valentin Reis
Browse files

slowly adding mtl stuff.

parent 7cea5526
...@@ -47,7 +47,6 @@ import System.Process.Typed ( readProcessStdout_ ...@@ -47,7 +47,6 @@ import System.Process.Typed ( readProcessStdout_
, proc , proc
, shell , shell
, setEnv , setEnv
, setEnvInherit
) )
import Text.Show.Pretty import Text.Show.Pretty
......
...@@ -92,7 +92,7 @@ myWhich str = ...@@ -92,7 +92,7 @@ myWhich str =
"" -> die $ "Argo `" <> str <> "` not in $PATH." "" -> die $ "Argo `" <> str <> "` not in $PATH."
p -> printInfo ("Found " <> str <> " at " <> p) $> p p -> printInfo ("Found " <> str <> " at " <> p) $> p
sudoRemoveFile ::(Text -> IO ()) -> Text -> Text -> IO () sudoRemoveFile :: (Text -> IO ()) -> Text -> Text -> IO ()
sudoRemoveFile printer desc filePath = do sudoRemoveFile printer desc filePath = do
foundSocket <- doesFileExist $ toS filePath foundSocket <- doesFileExist $ toS filePath
when foundSocket $ go False when foundSocket $ go False
...@@ -149,27 +149,35 @@ withAsyncs :: IO a -> IO a1 -> (Async a -> Async a1 -> IO b) -> IO b ...@@ -149,27 +149,35 @@ withAsyncs :: IO a -> IO a1 -> (Async a -> Async a1 -> IO b) -> IO b
withAsyncs io1 io2 f = withAsync io1 $ \a1 -> withAsync io2 $ \a2 -> f a1 a2 withAsyncs io1 io2 f = withAsync io1 $ \a1 -> withAsync io2 $ \a2 -> f a1 a2
doFilter doFilter
:: Maybe TextBehavior :: (MonadIO m)
-> ConduitT () ByteString IO () => Maybe TextBehavior
-> ConduitT ByteString Void IO () -> ConduitT () ByteString m ()
-> IO TracebackScan -> ConduitT ByteString Void m ()
-> m TracebackScan
doFilter behavior source sink = doFilter behavior source sink =
runConduit $ source .| CB.lines .| makeBehavior behavior `fuseUpstream` sink runConduit $ source .| CB.lines .| makeBehavior behavior `fuseUpstream` sink
makeBehavior makeBehavior
:: Maybe TextBehavior -> ConduitT ByteString ByteString IO TracebackScan :: (MonadIO m)
=> Maybe TextBehavior
-> ConduitT ByteString ByteString m TracebackScan
makeBehavior = \case makeBehavior = \case
Just ExpectClean -> warnOnTraceback False Just ExpectClean -> warnOnTraceback False
Just (WaitFor message) -> untilMatch message False Just (WaitFor message) -> untilMatch message False
Nothing -> awaitForever yield $> Clean Nothing -> awaitForever yield $> Clean
warnOnTraceback :: Bool -> ConduitT ByteString ByteString IO TracebackScan warnOnTraceback
:: (MonadIO m) => Bool -> ConduitT ByteString ByteString m TracebackScan
warnOnTraceback sawTraceback = await >>= \case warnOnTraceback sawTraceback = await >>= \case
Just b | B.isInfixOf "Traceback" b -> yield b >> warnOnTraceback True Just b | B.isInfixOf "Traceback" b -> yield b >> warnOnTraceback True
| otherwise -> yield b >> warnOnTraceback sawTraceback | otherwise -> yield b >> warnOnTraceback sawTraceback
Nothing -> if sawTraceback then return WarningTraceback else return Clean Nothing -> if sawTraceback then return WarningTraceback else return Clean
untilMatch :: Text -> Bool -> ConduitT ByteString ByteString IO TracebackScan untilMatch
:: (MonadIO m)
=> Text
-> Bool
-> ConduitT ByteString ByteString m TracebackScan
untilMatch msg sawTraceback = await >>= \case untilMatch msg sawTraceback = await >>= \case
Just b Just b
| B.isInfixOf "Traceback" b | B.isInfixOf "Traceback" b
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment