Main.app: call graphicCapture directlyv1.0.1

1 files changed, 31 insertions, 71 deletions

diff --git a/src/main.hs b/src/main.hs
index d45404f..133f51c 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -9,11 +9,11 @@ import Blessings.Text
 import Control.Concurrent.Extended
 import Control.Exception
 import Control.Monad
-import qualified Data.Text.Extended as T
+import Data.Int (Int32)
 import qualified Data.Text.IO as T
+import Data.Word (Word32)
 import DBus
 import DBus.Client
-import DBus.Socket
 import DBus.Internal.Message
 import DBus.Internal.Types
 import Flameshot.Internal
@@ -21,30 +21,17 @@ import qualified Flameshot.Internal.Process as P
 --import System.Exit
 import System.Environment
 import System.IO
+import System.Random
 
 
 main :: IO ()
 main =
-    getSessionAddress >>= \case
-      Just addr ->
-        withSocket addr $ \sock -> do
-          send sock (methodCall dbusPath dbusInterface "Hello")
-              { methodCallDestination = Just "org.freedesktop.DBus"
-              } (\_ser -> return ())
-          _ <- receive sock
-          bracket connectSession disconnect (app sock)
-      Nothing ->
-        error
-          (mconcat
-            [ "DBus session bus address not found; "
-            , "is DBUS_SESSION_BUS_ADDRESS set properly?"
-            ])
-
-app :: Socket -> Client -> IO ()
-app sock client = do
+    bracket connectSession disconnect app
+
+app :: Client -> IO ()
+app client = do
     (captureFinish, awaitCaptureFinish) <- newRelay
-    (captureBegin, awaitCaptureBegin) <- newSemaphore
-    (daemonJoin, awaitDaemonJoin) <- newRelay
+    (daemonJoin, awaitDaemonJoin) <- newSemaphore
     (daemonPart, awaitDaemonPart) <- newSemaphore
     (daemonStop, awaitDaemonStop) <- newSemaphore
 
@@ -79,7 +66,7 @@ app sock client = do
           }
           ->
             if new_owner /= ""
-              then daemonJoin (busName_ (T.unpack new_owner))
+              then daemonJoin
               else daemonPart
 
         Signal
@@ -106,19 +93,6 @@ app sock client = do
         _sig ->
           return ()
 
-    send sock (methodCall dbusPath dbusInterface "AddMatch")
-      { methodCallDestination = Just "org.freedesktop.DBus"
-      , methodCallBody =
-        [ toVariant (T.intercalate ","
-                        [ "type='method_call'"
-                        , "eavesdrop=true"
-                        , "path=/"
-                        , "destination=org.dharkael.Flameshot"
-                        , "member=graphicCapture"
-                        ] )
-        ]
-      } (\_ser -> return ())
-
     let
       runDaemon =
         P.run "flameshot" [] Nothing Nothing "" Nothing P.Callbacks
@@ -132,30 +106,6 @@ app sock client = do
 
           , P.onStart = \_ -> return ()
           }
-      runGui =
-        P.run "flameshot" ["gui", "-p", cGuiPath] Nothing Nothing "" Nothing P.Callbacks
-          { P.onOutLine = \_ s -> putLog $ "gui stdout: " <> Plain s
-          , P.onErrLine = \_ s -> putLog $ "gui stderr: " <> red (Plain s)
-          , P.onError = \_ _err -> return ()
-          , P.onExit = \_ _ -> return ()
-          , P.onStart = \_ -> return ()
-          }
-      runReceiver =
-        forever $ receive sock >>= \case
-          ReceivedMethodCall _ser MethodCall
-            { methodCallSender = Just _sender
-            , methodCallBody =
-              [ Variant (ValueAtom (AtomText _path))
-              , Variant (ValueAtom (AtomInt32 _delay))
-              , Variant (ValueAtom (AtomWord32 _callId))
-              ]
-            }
-            -> do
-            captureBegin
-
-          _received ->
-            return ()
-
       runLogPrinter =
         forever $ takeLog >>= T.hPutStrLn stderr . pp
 
@@ -171,15 +121,25 @@ app sock client = do
           withTimeout time f s v (const io)
 
     withThread_ runLogPrinter $ do
-      withThread_ runReceiver $ do
-        withThread runDaemon $ \daemonThread -> do
-          withTimeout 100000 awaitDaemonJoin "daemon" "join" $ \_daemonBusName -> do
-            withThread_ runGui $ do
-              withTimeout_ 100000 awaitCaptureBegin "gui" "join" $ do
-                _maybeRawImage <- awaitCaptureFinish
-                return ()
-
-              killThread daemonThread
-
-              withTimeout_ 100000 awaitDaemonPart "daemon" "part" (return ())
-              withTimeout_ 100000 awaitDaemonStop "daemon" "stop" (return ())
+      withThread runDaemon $ \daemonThread -> do
+        withTimeout_ 100000 awaitDaemonJoin "daemon" "join" $ do
+          callId <- getStdRandom random :: IO Word32
+          call client (methodCall "/" "" "graphicCapture")
+              { methodCallDestination = Just "org.dharkael.Flameshot"
+              , methodCallInterface = Nothing
+              , methodCallBody =
+                [ toVariant cGuiPath
+                , toVariant (0 :: Int32)
+                , toVariant callId
+                ]
+              } >>= \case
+            Right MethodReturn{} ->
+              awaitCaptureFinish >>= mapM_ (saveImage cGuiPath)
+
+            Left err ->
+              putLog $ "capture failed: " <> blessMethodError err
+
+          killThread daemonThread
+
+          withTimeout_ 100000 awaitDaemonPart "daemon" "part" (return ())
+          withTimeout_ 100000 awaitDaemonStop "daemon" "stop" (return ())