Main.app: make timeout configurablev1.2.0

Because sometimes 100ms just aren't enough... ^_^

1 files changed, 14 insertions, 3 deletions

diff --git a/src/main.hs b/src/main.hs
index 851dd7f..de86355 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -11,6 +11,7 @@ import Control.Exception
 import Control.Monad
 import Data.Int (Int32)
 import qualified Data.Text.IO as T
+import Data.Maybe (fromMaybe)
 import Data.Word (Word32)
 import DBus
 import DBus.Client
@@ -22,6 +23,7 @@ import qualified Flameshot.Internal.Process as P
 import System.Environment
 import System.IO
 import System.Random
+import Text.Read (readMaybe)
 
 
 main :: IO ()
@@ -36,10 +38,19 @@ app client = do
     (daemonStop, awaitDaemonStop) <- newSemaphore
 
     cGuiPath <- getEnv "FLAMESHOT_CAPTURE_PATH"
+
     let
         cLogTime = True
         cLogHandle = stderr
 
+    cTimeout <-
+      let
+        def = 100
+        err = error $ "failed to read integer from " <> var
+        var = "FLAMESHOT_ONCE_TIMEOUT"
+      in
+        (1000*) . maybe def (fromMaybe err . readMaybe) <$> lookupEnv var
+
     hSetBuffering cLogHandle LineBuffering
     logToTTY <- hIsTerminalDevice cLogHandle
     (putLog, takeLog0) <- newChan
@@ -122,7 +133,7 @@ app client = do
 
     withThread_ runLogPrinter $ do
       withThread runDaemon $ \daemonThread -> do
-        withTimeout_ 100000 awaitDaemonJoin "daemon" "join" $ do
+        withTimeout_ cTimeout awaitDaemonJoin "daemon" "join" $ do
           callId <- getStdRandom random :: IO Word32
           call client (methodCall "/" "" "graphicCapture")
               { methodCallDestination = Just "org.dharkael.Flameshot"
@@ -141,5 +152,5 @@ app client = do
 
           killThread daemonThread
 
-          withTimeout_ 100000 awaitDaemonPart "daemon" "part" (return ())
-          withTimeout_ 100000 awaitDaemonStop "daemon" "stop" (return ())
+          withTimeout_ cTimeout awaitDaemonPart "daemon" "part" (return ())
+          withTimeout_ cTimeout awaitDaemonStop "daemon" "stop" (return ())