{-# LANGUAGE OverloadedStrings #-} module StatusNotifier.Util where import Control.Arrow import Control.Lens import DBus.Client import qualified DBus.Generation as G import qualified DBus.Internal.Message as M import qualified DBus.Internal.Types as T import qualified DBus.Introspection as I import Data.Bits import qualified Data.ByteString as BS import Data.Maybe import qualified Data.Vector.Storable as VS import Data.Vector.Storable.ByteString import Data.Word import Language.Haskell.TH import StatusNotifier.TH import qualified Data.Text.IO as TIO import Data.Text (pack) import System.ByteOrder (fromBigEndian) import System.Log.Logger getIntrospectionObjectFromFile :: FilePath -> T.ObjectPath -> Q I.Object getIntrospectionObjectFromFile :: String -> ObjectPath -> Q Object getIntrospectionObjectFromFile String filepath ObjectPath nodePath = IO Object -> Q Object forall a. IO a -> Q a runIO (IO Object -> Q Object) -> IO Object -> Q Object forall a b. (a -> b) -> a -> b $ [Object] -> Object forall a. [a] -> a head ([Object] -> Object) -> (Text -> [Object]) -> Text -> Object forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe Object -> [Object] forall a. Maybe a -> [a] maybeToList (Maybe Object -> [Object]) -> (Text -> Maybe Object) -> Text -> [Object] forall b c a. (b -> c) -> (a -> b) -> a -> c . ObjectPath -> Text -> Maybe Object I.parseXML ObjectPath nodePath (Text -> Object) -> IO Text -> IO Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO Text TIO.readFile String filepath generateClientFromFile :: G.GenerationParams -> Bool -> FilePath -> Q [Dec] generateClientFromFile :: GenerationParams -> Bool -> String -> Q [Dec] generateClientFromFile GenerationParams params Bool useObjectPath String filepath = do Object object <- String -> ObjectPath -> Q Object getIntrospectionObjectFromFile String filepath ObjectPath "/" let interface :: Interface interface = [Interface] -> Interface forall a. [a] -> a head ([Interface] -> Interface) -> [Interface] -> Interface forall a b. (a -> b) -> a -> b $ Object -> [Interface] I.objectInterfaces Object object actualObjectPath :: ObjectPath actualObjectPath = Object -> ObjectPath I.objectPath Object object realParams :: GenerationParams realParams = if Bool useObjectPath then GenerationParams params { genObjectPath :: Maybe ObjectPath G.genObjectPath = ObjectPath -> Maybe ObjectPath forall a. a -> Maybe a Just ObjectPath actualObjectPath } else GenerationParams params [Dec] -> [Dec] -> [Dec] forall a. [a] -> [a] -> [a] (++) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenerationParams -> Interface -> Q [Dec] G.generateClient GenerationParams realParams Interface interface Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> GenerationParams -> Interface -> Q [Dec] G.generateSignalsFromInterface GenerationParams realParams Interface interface ifM :: Monad m => m Bool -> m a -> m a -> m a ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a ifM m Bool cond m a whenTrue m a whenFalse = m Bool cond m Bool -> (Bool -> m a) -> m a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (\Bool bool -> if Bool bool then m a whenTrue else m a whenFalse) makeLensesWithLSuffix :: Name -> DecsQ makeLensesWithLSuffix :: Name -> Q [Dec] makeLensesWithLSuffix = LensRules -> Name -> Q [Dec] makeLensesWith (LensRules -> Name -> Q [Dec]) -> LensRules -> Name -> Q [Dec] forall a b. (a -> b) -> a -> b $ LensRules lensRules LensRules -> (LensRules -> LensRules) -> LensRules forall a b. a -> (a -> b) -> b & (FieldNamer -> Identity FieldNamer) -> LensRules -> Identity LensRules Lens' LensRules FieldNamer lensField ((FieldNamer -> Identity FieldNamer) -> LensRules -> Identity LensRules) -> FieldNamer -> LensRules -> LensRules forall s t a b. ASetter s t a b -> b -> s -> t .~ \Name _ [Name] _ Name name -> [Name -> DefName TopName (String -> Name mkName (String -> Name) -> String -> Name forall a b. (a -> b) -> a -> b $ Name -> String nameBase Name name String -> String -> String forall a. [a] -> [a] -> [a] ++ String "L")] whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m () whenJust = ((a -> m ()) -> Maybe a -> m ()) -> Maybe a -> (a -> m ()) -> m () forall a b c. (a -> b -> c) -> b -> a -> c flip (((a -> m ()) -> Maybe a -> m ()) -> Maybe a -> (a -> m ()) -> m ()) -> ((a -> m ()) -> Maybe a -> m ()) -> Maybe a -> (a -> m ()) -> m () forall a b. (a -> b) -> a -> b $ m () -> (a -> m ()) -> Maybe a -> m () forall b a. b -> (a -> b) -> Maybe a -> b maybe (m () -> (a -> m ()) -> Maybe a -> m ()) -> m () -> (a -> m ()) -> Maybe a -> m () forall a b. (a -> b) -> a -> b $ () -> m () forall (m :: * -> *) a. Monad m => a -> m a return () convertARGBToABGR :: Word32 -> Word32 convertARGBToABGR :: Word32 -> Word32 convertARGBToABGR Word32 bits = (Word32 blue Word32 -> Int -> Word32 forall a. Bits a => a -> Int -> a `shift` Int 16) Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. (Word32 red Word32 -> Int -> Word32 forall a. Bits a => a -> Int -> a `shift` (-Int 16)) Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. Word32 green Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. Word32 alpha where blue :: Word32 blue = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. Word32 0xFF green :: Word32 green = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. Word32 0xFF00 red :: Word32 red = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. Word32 0xFF0000 alpha :: Word32 alpha = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. Word32 0xFF000000 networkToSystemByteOrder :: BS.ByteString -> BS.ByteString networkToSystemByteOrder :: ByteString -> ByteString networkToSystemByteOrder ByteString original = Vector Word32 -> ByteString forall a. Storable a => Vector a -> ByteString vectorToByteString (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString forall a b. (a -> b) -> a -> b $ (Word32 -> Word32) -> Vector Word32 -> Vector Word32 forall a b. (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b VS.map (Word32 -> Word32 convertARGBToABGR (Word32 -> Word32) -> (Word32 -> Word32) -> Word32 -> Word32 forall b c a. (b -> c) -> (a -> b) -> a -> c . Word32 -> Word32 forall a. Bytes a => a -> a fromBigEndian) (Vector Word32 -> Vector Word32) -> Vector Word32 -> Vector Word32 forall a b. (a -> b) -> a -> b $ ByteString -> Vector Word32 forall a. Storable a => ByteString -> Vector a byteStringToVector ByteString original maybeToEither :: b -> Maybe a -> Either b a maybeToEither :: forall b a. b -> Maybe a -> Either b a maybeToEither = (Either b a -> (a -> Either b a) -> Maybe a -> Either b a) -> (a -> Either b a) -> Either b a -> Maybe a -> Either b a forall a b c. (a -> b -> c) -> b -> a -> c flip Either b a -> (a -> Either b a) -> Maybe a -> Either b a forall b a. b -> (a -> b) -> Maybe a -> b maybe a -> Either b a forall a b. b -> Either a b Right (Either b a -> Maybe a -> Either b a) -> (b -> Either b a) -> b -> Maybe a -> Either b a forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> Either b a forall a b. a -> Either a b Left makeErrorReply :: ErrorName -> String -> Reply makeErrorReply :: ErrorName -> String -> Reply makeErrorReply ErrorName e String message = ErrorName -> [Variant] -> Reply ReplyError ErrorName e [String -> Variant forall a. IsVariant a => a -> Variant T.toVariant String message] logErrorWithDefault :: Show a => (Priority -> String -> IO ()) -> b -> String -> Either a b -> IO b logErrorWithDefault :: forall a b. Show a => (Priority -> String -> IO ()) -> b -> String -> Either a b -> IO b logErrorWithDefault Priority -> String -> IO () logger b def String message = (Maybe b -> b) -> IO (Maybe b) -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (b -> Maybe b -> b forall a. a -> Maybe a -> a fromMaybe b def) (IO (Maybe b) -> IO b) -> (Either a b -> IO (Maybe b)) -> Either a b -> IO b forall b c a. (b -> c) -> (a -> b) -> a -> c . (Priority -> String -> IO ()) -> String -> Either a b -> IO (Maybe b) forall a b. Show a => (Priority -> String -> IO ()) -> String -> Either a b -> IO (Maybe b) logEitherError Priority -> String -> IO () logger String message logEitherError :: Show a => (Priority -> String -> IO ()) -> String -> Either a b -> IO (Maybe b) logEitherError :: forall a b. Show a => (Priority -> String -> IO ()) -> String -> Either a b -> IO (Maybe b) logEitherError Priority -> String -> IO () logger String message = (a -> IO (Maybe b)) -> (b -> IO (Maybe b)) -> Either a b -> IO (Maybe b) forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (\a err -> Priority -> String -> IO () logger Priority ERROR (String message String -> String -> String forall a. [a] -> [a] -> [a] ++ a -> String forall a. Show a => a -> String show a err) IO () -> IO (Maybe b) -> IO (Maybe b) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Maybe b -> IO (Maybe b) forall (m :: * -> *) a. Monad m => a -> m a return Maybe b forall a. Maybe a Nothing) (Maybe b -> IO (Maybe b) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe b -> IO (Maybe b)) -> (b -> Maybe b) -> b -> IO (Maybe b) forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> Maybe b forall a. a -> Maybe a Just) exemptUnknownMethod :: b -> Either M.MethodError b -> Either M.MethodError b exemptUnknownMethod :: forall b. b -> Either MethodError b -> Either MethodError b exemptUnknownMethod b def Either MethodError b eitherV = case Either MethodError b eitherV of Right b _ -> Either MethodError b eitherV Left M.MethodError { methodErrorName :: MethodError -> ErrorName M.methodErrorName = ErrorName errorName } -> if ErrorName errorName ErrorName -> ErrorName -> Bool forall a. Eq a => a -> a -> Bool == ErrorName errorUnknownMethod then b -> Either MethodError b forall a b. b -> Either a b Right b def else Either MethodError b eitherV exemptAll :: b -> Either M.MethodError b -> Either M.MethodError b exemptAll :: forall b. b -> Either MethodError b -> Either MethodError b exemptAll b def Either MethodError b eitherV = case Either MethodError b eitherV of Right b _ -> Either MethodError b eitherV Left MethodError _ -> b -> Either MethodError b forall a b. b -> Either a b Right b def infixl 4 <..> (<..>) :: Functor f => (a -> b) -> f (f a) -> f (f b) <..> :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f (f a) -> f (f b) (<..>) = (f a -> f b) -> f (f a) -> f (f b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((f a -> f b) -> f (f a) -> f (f b)) -> ((a -> b) -> f a -> f b) -> (a -> b) -> f (f a) -> f (f b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap infixl 4 <<$>> (<<$>>) :: (a -> IO b) -> Maybe a -> IO (Maybe b) a -> IO b fn <<$>> :: forall a b. (a -> IO b) -> Maybe a -> IO (Maybe b) <<$>> Maybe a m = Maybe (IO b) -> IO (Maybe b) forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) sequenceA (Maybe (IO b) -> IO (Maybe b)) -> Maybe (IO b) -> IO (Maybe b) forall a b. (a -> b) -> a -> b $ a -> IO b fn (a -> IO b) -> Maybe a -> Maybe (IO b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe a m forkM :: Monad m => (i -> m a) -> (i -> m b) -> i -> m (a, b) forkM :: forall (m :: * -> *) i a b. Monad m => (i -> m a) -> (i -> m b) -> i -> m (a, b) forkM i -> m a a i -> m b b i i = do a r1 <- i -> m a a i i b r2 <- i -> m b b i i (a, b) -> m (a, b) forall (m :: * -> *) a. Monad m => a -> m a return (a r1, b r2) tee :: Monad m => (i -> m a) -> (i -> m b) -> i -> m a tee :: forall (m :: * -> *) i a b. Monad m => (i -> m a) -> (i -> m b) -> i -> m a tee = ((((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a) -> ((i -> m a) -> (i -> m b) -> i -> m (a, b)) -> (i -> m a) -> (i -> m b) -> i -> m a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a) -> ((i -> m a) -> (i -> m b) -> i -> m (a, b)) -> (i -> m a) -> (i -> m b) -> i -> m a) -> ((m (a, b) -> m a) -> ((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a) -> (m (a, b) -> m a) -> ((i -> m a) -> (i -> m b) -> i -> m (a, b)) -> (i -> m a) -> (i -> m b) -> i -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((i -> m (a, b)) -> i -> m a) -> ((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (((i -> m (a, b)) -> i -> m a) -> ((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a) -> ((m (a, b) -> m a) -> (i -> m (a, b)) -> i -> m a) -> (m (a, b) -> m a) -> ((i -> m b) -> i -> m (a, b)) -> (i -> m b) -> i -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . (m (a, b) -> m a) -> (i -> m (a, b)) -> i -> m a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap) (((a, b) -> a) -> m (a, b) -> m a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, b) -> a forall a b. (a, b) -> a fst) (i -> m a) -> (i -> m b) -> i -> m (a, b) forall (m :: * -> *) i a b. Monad m => (i -> m a) -> (i -> m b) -> i -> m (a, b) forkM (>>=/) :: Monad m => m a -> (a -> m b) -> m a >>=/ :: forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m a (>>=/) m a a = (m a a m a -> (a -> m a) -> m a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>=) ((a -> m a) -> m a) -> ((a -> m b) -> a -> m a) -> (a -> m b) -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> m a) -> (a -> m b) -> a -> m a forall (m :: * -> *) i a b. Monad m => (i -> m a) -> (i -> m b) -> i -> m a tee a -> m a forall (m :: * -> *) a. Monad m => a -> m a return getInterfaceAt :: Client -> T.BusName -> T.ObjectPath -> IO (Either M.MethodError (Maybe I.Object)) getInterfaceAt :: Client -> BusName -> ObjectPath -> IO (Either MethodError (Maybe Object)) getInterfaceAt Client client BusName bus ObjectPath path = (String -> Maybe Object) -> Either MethodError String -> Either MethodError (Maybe Object) forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either d b) (Either d c) right (ObjectPath -> Text -> Maybe Object I.parseXML ObjectPath "/" (Text -> Maybe Object) -> (String -> Text) -> String -> Maybe Object forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack) (Either MethodError String -> Either MethodError (Maybe Object)) -> IO (Either MethodError String) -> IO (Either MethodError (Maybe Object)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Client -> BusName -> ObjectPath -> IO (Either MethodError String) introspect Client client BusName bus ObjectPath path findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM a -> m Bool p [] = Maybe a -> m (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return Maybe a forall a. Maybe a Nothing findM a -> m Bool p (a x:[a] xs) = m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a) forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a ifM (a -> m Bool p a x) (Maybe a -> m (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a) forall a b. (a -> b) -> a -> b $ a -> Maybe a forall a. a -> Maybe a Just a x) ((a -> m Bool) -> [a] -> m (Maybe a) forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM a -> m Bool p [a] xs)