start using Runner monad

Handler/Runner.hs

@@ -30,7 +30,7 @@ instance Functor Runner where
 
 instance Applicative Runner where
   pure v = Runner {
-    runRunner = \chan -> return $ RunnerOK v
+    runRunner = \_ -> return $ RunnerOK v
     }
   liftA2 f runner1 runner2 = Runner {
     runRunner = \chan -> do
@@ -44,8 +44,28 @@ instance Applicative Runner where
           RunnerError e -> return $ RunnerError e
     }
 
-run :: Maybe FilePath -> FilePath -> [String] -> Runner ()
+instance Monad Runner where
-run workingDir programPath args = Runner {
+  runner >>= k = Runner {
+    runRunner = \chan -> do
+        s <- (runRunner runner) chan
+        case s of
+          RunnerError e -> return $ RunnerError e
+          RunnerOK v -> do
+            sn <- (runRunner (k v)) chan
+            return $ case sn of
+              RunnerError e -> RunnerError e
+              RunnerOK w -> RunnerOK w
+    }
+
+runWithChannel :: Channel -> Runner () -> Handler ExitCode
+runWithChannel chan runner = do
+  s <- (runRunner runner) chan
+  return $ case s of
+             RunnerOK () -> ExitSuccess
+             RunnerError e -> e
+
+runProg :: Maybe FilePath -> FilePath -> [String] -> Runner ()
+runProg workingDir programPath args = Runner {
   runRunner = \chan -> do
       (code, _) <- runProgram workingDir programPath args chan
       case code of

Handler/Shared.hs

@@ -215,41 +215,33 @@ cloneRepo' repoCloningSpec chan = do
         err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
         return Nothing
 
-rawClone :: FilePath -> RepoCloningSpec -> Channel -> Handler (ExitCode)
+rawClone :: FilePath -> RepoCloningSpec -> Channel -> Handler ExitCode
-rawClone tmpRepoDir repoCloningSpec chan = do
+rawClone tmpRepoDir repoCloningSpec chan = runWithChannel chan $ do
   let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec
   let branch = repoSpecBranch $ cloningSpecRepo repoCloningSpec
   let referenceUrl = repoSpecUrl $ cloningSpecReferenceRepo repoCloningSpec
   let referenceBranch = repoSpecBranch $ cloningSpecReferenceRepo repoCloningSpec
-  (exitCode, _) <- runProgram Nothing gitPath ["clone",
+  runProg Nothing gitPath ["clone",
                            "--progress",
                            "--branch",
                            T.unpack referenceBranch,
                            T.unpack referenceUrl,
-                                              tmpRepoDir] chan
+                           tmpRepoDir]
   if url /= referenceUrl || branch /= referenceBranch
     then
       do
-      (exitCode, _) <- runProgram (Just tmpRepoDir) gitPath ["remote",
+       runProg (Just tmpRepoDir) gitPath ["remote",
                                            "set-url",
                                            "origin",
-                                                            T.unpack url] chan
+                                           T.unpack url]
-      case exitCode of
+       runProg (Just tmpRepoDir) gitPath ["fetch",
-       ExitSuccess -> do
-         (exitCode, _) <- runProgram (Just tmpRepoDir) gitPath ["fetch",
                                            "origin",
-                                                               T.unpack branch] chan
+                                           T.unpack branch]
-         case exitCode of
+       runProg (Just tmpRepoDir) gitPath ["reset",
-           ExitSuccess -> do
-             (exitCode, _) <- runProgram (Just tmpRepoDir) gitPath ["reset",
                                            "--hard",
-                                                                   "FETCH_HEAD"] chan
+                                           "FETCH_HEAD"]
-             return exitCode
-           _ -> return exitCode
-       _ -> return exitCode
-
     else
-      return exitCode
+      return ()
 
 getRepoDir :: Key Repo -> Handler FilePath
 getRepoDir repoId = do