-- This file is part of Qtah.
--
-- Copyright 2015-2020 The Qtah Authors.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program. If not, see .
{-# LANGUAGE ExistentialQuantification, FlexibleContexts #-}
-- | General routines for managing Qt signals.
module Graphics.UI.Qtah.Signal (
Signal (..),
Connection,
connect,
connect_,
disconnect,
connectionIsValid,
-- * Internal
internalMakeConnection,
) where
import Control.Concurrent (MVar, modifyMVar, newMVar, readMVar)
import Control.Monad (unless)
import Data.Maybe (isJust)
import Foreign.Hoppy.Runtime (Deletable, delete)
data SomeDeletable = forall a. Deletable a => SomeDeletable a
-- | A signal that can be connected to an instance of the @object@ (C++) class,
-- and when invoked will call a function of the given @handler@ type.
data Signal object handler = Signal
{ internalConnectSignal :: object -> handler -> IO (Maybe Connection)
, internalName :: String
}
instance Show (Signal object handler) where
show signal = concat [""]
-- | A handle representing a callback function that has been connected to a Qt
-- signal on a specific object. A connection is created by 'connect' or
-- 'connect_'. The callback function may be unregistered by passing this object
-- to the 'disconnect' function, after which 'connectionIsValid' will return
-- false.
newtype Connection = Connection (MVar (Maybe SomeDeletable))
-- | Internal function. Constructs a 'Connection' from a listener object.
internalMakeConnection :: Deletable a => a -> IO Connection
internalMakeConnection listener = do
listenerVar <- newMVar $ Just $ SomeDeletable listener
return $ Connection listenerVar
-- | Registers a handler function to listen to a signal an object emits. If the
-- connection is made successfully, a handle representing the connection is
-- returned, otherwise @Nothing@ is returned.
connect :: object -> Signal object handler -> handler -> IO (Maybe Connection)
connect = flip internalConnectSignal
-- | Registers a handler function to listen to a signal an object emits, via
-- 'connect'. If the connection fails, then the program aborts.
connect_ :: object -> Signal object handler -> handler -> IO ()
connect_ object signal handler = do
maybeConnection <- connect object signal handler
unless (isJust maybeConnection) $
fail $ "connect_: Failed to connect signal " ++ show signal ++ "."
-- | Disconnects a connection previously created through 'connect', returning
-- true on success.
--
-- Passing a connection that has already been disconnected does nothing and
-- returns false.
disconnect :: Connection -> IO Bool
disconnect (Connection listenerVar) =
modifyMVar listenerVar $ \maybeListener -> case maybeListener of
Just (SomeDeletable listener) -> do
delete listener
return (Nothing, True)
Nothing ->
return (Nothing, False)
-- | Returns true if the connection is still valid, i.e. its callback function
-- is still connected to its signal.
connectionIsValid :: Connection -> IO Bool
connectionIsValid (Connection listenerVar) = isJust <$> readMVar listenerVar