diff --git a/Manatee/Extension/IrcClient/DBus.hs b/Manatee/Extension/IrcClient/DBus.hs --- a/Manatee/Extension/IrcClient/DBus.hs +++ b/Manatee/Extension/IrcClient/DBus.hs @@ -25,7 +25,6 @@ import DBus.MatchRule import DBus.Message (Signal, signalBody) import DBus.Types -import Data.Maybe (fromMaybe) import Data.Text.Lazy (Text, empty) import Graphics.UI.Gtk.General.General import Language.Haskell.TH @@ -33,12 +32,14 @@ import Manatee.Core.TH import Manatee.Extension.IrcClient.Types import Manatee.Toolkit.General.DBus +import Manatee.Toolkit.General.Maybe import Manatee.Toolkit.General.Misc import Network.FastIRC.Types import System.Posix.Process import System.Posix.Types (ProcessID) import qualified Data.ByteString.Char8 as B +import qualified Control.Exception as Exc data IrcDaemonMember = Join | Part @@ -88,8 +89,8 @@ mkFunDec "checkIrcDaemonSignalArgs" (checkSignalArgs ''IrcDaemonMember ''IrcDaemonSignalArgs) -- | Unpack daemon signal from Variant list. --- unpackIrcDaemonSignalArgs_ :: IrcDaemonMember -> [Variant] -> Maybe IrcDaemonSignalArgs -mkFunDec "unpackIrcDaemonSignalArgs_" (unpackVariantList ''IrcDaemonMember ''IrcDaemonSignalArgs) +-- unpackIrcDaemonSignalArgs :: IrcDaemonMember -> [Variant] -> Maybe IrcDaemonSignalArgs +mkFunDec "unpackIrcDaemonSignalArgs" (unpackVariantList ''IrcDaemonMember ''IrcDaemonSignalArgs) -- | Pack daemon signal argument to Variant list. -- packIrcDaemonSignalArgs :: IrcDaemonSignalArgs -> [Variant] @@ -100,8 +101,8 @@ mkFunDec "checkIrcClientSignalArgs" (checkSignalArgs ''IrcClientMember ''IrcClientSignalArgs) -- | Unpack client signal from Variant list. --- unpackIrcClientSignalArgs_ :: IrcClientMember -> [Variant] -> Maybe IrcClientSignalArgs -mkFunDec "unpackIrcClientSignalArgs_" (unpackVariantList ''IrcClientMember ''IrcClientSignalArgs) +-- unpackIrcClientSignalArgs :: IrcClientMember -> [Variant] -> Maybe IrcClientSignalArgs +mkFunDec "unpackIrcClientSignalArgs" (unpackVariantList ''IrcClientMember ''IrcClientSignalArgs) -- | Pack client signal argument to Variant list. -- packIrcClientSignalArgs :: IrcClientSignalArgs -> [Variant] @@ -126,7 +127,7 @@ mkIrcDaemonMatchRule :: Client -> (IrcDaemonMember, IrcDaemonSignalArgs -> IO ()) -> IO () mkIrcDaemonMatchRule client (member, fun) = onSignal client matchRule $ \_ signal -> - fun $ pickIrcDaemonSignalArgs member signal + pickIrcDaemonSignalArgs member signal >?>= fun where matchRule = mkMatchRule (Just Signal) empty @@ -141,26 +142,22 @@ mkIrcDaemonMatchRules client = mapM_ (mkIrcDaemonMatchRule client) -- | Pick IrcDaemonSignalArgs. -pickIrcDaemonSignalArgs :: IrcDaemonMember -> Signal -> IrcDaemonSignalArgs -pickIrcDaemonSignalArgs member signal = unpackIrcDaemonSignalArgs member $ signalBody signal - --- | Unpack daemon signal from Variant list. --- Report error if mismatch. -unpackIrcDaemonSignalArgs member args = - fromMaybe - (error $ "unpackIrcDaemonSignalArgs: Miss pattern for " ++ show member) - (unpackIrcDaemonSignalArgs_ member args) +pickIrcDaemonSignalArgs :: IrcDaemonMember -> Signal -> IO (Maybe IrcDaemonSignalArgs) +pickIrcDaemonSignalArgs member signal = + Exc.catch + (return $ unpackIrcDaemonSignalArgs member $ signalBody signal) + (\ (_ :: Exc.SomeException) -> + printDBusMessageError "pickIrcDaemonSignalArgs" (show member) + >> return Nothing) -- | Pick IrcClientSignalArgs. -pickIrcClientSignalArgs :: IrcClientMember -> Signal -> IrcClientSignalArgs -pickIrcClientSignalArgs member signal = unpackIrcClientSignalArgs member $ signalBody signal - --- | Unpack client signal from Variant list. --- Report error if mismatch. -unpackIrcClientSignalArgs member args = - fromMaybe - (error $ "unpackIrcClientSignalArgs: Miss pattern for " ++ show member) - (unpackIrcClientSignalArgs_ member args) +pickIrcClientSignalArgs :: IrcClientMember -> Signal -> IO (Maybe IrcClientSignalArgs) +pickIrcClientSignalArgs member signal = + Exc.catch + (return $ unpackIrcClientSignalArgs member $ signalBody signal) + (\ (_ :: Exc.SomeException) -> + printDBusMessageError "pickIrcClientSignalArgs" (show member) + >> return Nothing) -- | Build render signal. -- If signal argument not match render member name. @@ -191,7 +188,7 @@ [] -- Use postGUIAsync wrap DBus action to protect gtk+ main thread. onSignal client matchRule $ \_ signal -> - postGUIAsync $ fun $ pickIrcClientSignalArgs member signal + pickIrcClientSignalArgs member signal >?>= (postGUIAsync . fun) -- | Build irc client match rule for catch signal. mkIrcClientMatchRules :: Client -> [(IrcClientMember, IrcClientSignalArgs -> IO ())] -> IO () diff --git a/manatee-ircclient.cabal b/manatee-ircclient.cabal --- a/manatee-ircclient.cabal +++ b/manatee-ircclient.cabal @@ -1,5 +1,5 @@ name: manatee-ircclient -version: 0.0.5 +version: 0.0.6 Cabal-Version: >= 1.6 license: GPL-3 license-file: LICENSE @@ -7,6 +7,8 @@ synopsis: IRC client extension for Manatee. description: manatee-ircclient is IRC client extension for Manatee (Haskell/Gtk+ Integrated Live Environment) . + Video at (Select 720p HD) at : + . Screenshots at : . Manual at : @@ -45,7 +47,7 @@ location: http://patch-tag.com/r/AndyStewart/manatee-ircclient Library - build-depends: base >= 4 && < 5, manatee-core >= 0.0.5, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, + build-depends: base >= 4 && < 5, manatee-core >= 0.0.6, dbus-client >= 0.3 && < 0.4, stm >= 2.1.2.0, containers >= 0.3.0.0, gtk-serialized-event >= 0.12.0, gtk >= 0.12.0, text >= 0.7.1.0, bytestring >= 0.9.1.5, dbus-core, template-haskell, gtksourceview2 >= 0.12.0, unix >= 2.4.0.0,