Add timeout error to synthesisers

1 files changed, 14 insertions, 7 deletions

diff --git a/src/VeriFuzz/Sim/Internal.hs b/src/VeriFuzz/Sim/Internal.hs
index 5c58e1a..d35ad86 100644
--- a/src/VeriFuzz/Sim/Internal.hs
+++ b/src/VeriFuzz/Sim/Internal.hs
@@ -188,21 +188,28 @@ logCommand_ :: FilePath -> Text -> Sh a -> Sh ()
 logCommand_ fp name = void . logCommand fp name
 
 execute
-    :: (MonadSh m, Monad m, Monoid a)
-    => a
+    :: (MonadSh m, Monad m)
+    => Failed
     -> FilePath
     -> Text
     -> FilePath
     -> [Text]
-    -> ResultT a m Text
-execute f dir name e = annotate f . liftSh . logCommand dir name . timeout e
+    -> ResultT Failed m Text
+execute f dir name e cs = do
+    (res, exitCode) <- liftSh $ do
+        res <- errExit False . logCommand dir name $ timeout e cs
+        (,) res <$> lastExitCode
+    case exitCode of
+        0   -> ResultT . return $ Pass res
+        124 -> ResultT . return $ Fail TimeoutError
+        _   -> ResultT . return $ Fail f
 
 execute_
-    :: (MonadSh m, Monad m, Monoid a)
-    => a
+    :: (MonadSh m, Monad m)
+    => Failed
     -> FilePath
     -> Text
     -> FilePath
     -> [Text]
-    -> ResultT a m ()
+    -> ResultT Failed m ()
 execute_ a b c d = void . execute a b c d