Main.app: support upload to Imgur

1 files changed, 15 insertions, 0 deletions

diff --git a/src/main.hs b/src/main.hs
index a08228b..5932976 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -10,6 +10,7 @@ import Control.Concurrent.Extended
 import Control.Exception
 import Control.Monad
 import Data.Int (Int32)
+import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Maybe (fromMaybe)
 import Data.Word (Word32)
@@ -118,6 +119,16 @@ app client = do
             }
       runLogPrinter =
         forever $ takeLog >>= T.hPutStrLn stderr . pp
+      runWindowWaiter name onQuit = do
+        P.run "xwaitforwindow" ["-name", name] Nothing Nothing "" Nothing $
+          logger putLog ("xwaitforwindow(name=" <> T.pack (show name) <> ")") <>
+          mempty
+            { P.onError = \_ _ -> onQuit
+            , P.onExit = \_ _ -> onQuit
+            }
+      waitForWindow name = do
+        (waiterStop, awaitWaiterStop) <- newSemaphore
+        withThread_ (runWindowWaiter name waiterStop) awaitWaiterStop
 
     let
       withTimeout time f s v io =
@@ -149,6 +160,10 @@ app client = do
             Left err ->
               putLog $ "capture failed: " <> blessMethodError err
 
+          -- sleep in order give the upload window a chance to appear
+          threadDelay cTimeout
+          waitForWindow "Upload to Imgur"
+
           killThread daemonThread
 
           withTimeout_ cTimeout awaitDaemonPart "daemon" "part" (return ())