summaryrefslogtreecommitdiffstats
path: root/src/main.hs
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2019-02-07 22:05:33 +0100
committertv <tv@krebsco.de>2019-02-07 22:08:44 +0100
commit03623ce6c011c1e85df7d91aed4458c098ff22ff (patch)
tree5a1a44376beb1bd6b12c20fbc4272188e9d7f677 /src/main.hs
parentfb5636483871fbafe9b286b377c339c8ddf8b4f8 (diff)
Main.app: call graphicCapture directlyv1.0.1
Diffstat (limited to 'src/main.hs')
-rw-r--r--src/main.hs102
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 ())