{-# 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 :: FilePath -> ObjectPath -> Q Object getIntrospectionObjectFromFile filepath :: FilePath filepath nodePath :: 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 <$> FilePath -> IO Text TIO.readFile FilePath filepath generateClientFromFile :: G.GenerationParams -> Bool -> FilePath -> Q [Dec] generateClientFromFile :: GenerationParams -> Bool -> FilePath -> Q [Dec] generateClientFromFile params :: GenerationParams params useObjectPath :: Bool useObjectPath filepath :: FilePath filepath = do Object object <- FilePath -> ObjectPath -> Q Object getIntrospectionObjectFromFile FilePath filepath "/" 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 :: m Bool -> m a -> m a -> m a ifM cond :: m Bool cond whenTrue :: m a whenTrue whenFalse :: 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 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 -> DefName TopName (FilePath -> Name mkName (FilePath -> Name) -> FilePath -> Name forall a b. (a -> b) -> a -> b $ Name -> FilePath nameBase Name name FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ "L")] whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust :: 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 bits :: Word32 bits = (Word32 blue Word32 -> Int -> Word32 forall a. Bits a => a -> Int -> a `shift` 16) Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. (Word32 red Word32 -> Int -> Word32 forall a. Bits a => a -> Int -> a `shift` (-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 .&. 0xFF green :: Word32 green = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. 0xFF00 red :: Word32 red = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. 0xFF0000 alpha :: Word32 alpha = Word32 bits Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .&. 0xFF000000 networkToSystemByteOrder :: BS.ByteString -> BS.ByteString networkToSystemByteOrder :: ByteString -> ByteString networkToSystemByteOrder original :: 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 :: 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 -> FilePath -> Reply makeErrorReply e :: ErrorName e message :: FilePath message = ErrorName -> [Variant] -> Reply ReplyError ErrorName e [FilePath -> Variant forall a. IsVariant a => a -> Variant T.toVariant FilePath message] logErrorWithDefault :: Show a => (Priority -> String -> IO ()) -> b -> String -> Either a b -> IO b logErrorWithDefault :: (Priority -> FilePath -> IO ()) -> b -> FilePath -> Either a b -> IO b logErrorWithDefault logger :: Priority -> FilePath -> IO () logger def :: b def message :: FilePath 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 -> FilePath -> IO ()) -> FilePath -> Either a b -> IO (Maybe b) forall a b. Show a => (Priority -> FilePath -> IO ()) -> FilePath -> Either a b -> IO (Maybe b) logEitherError Priority -> FilePath -> IO () logger FilePath message logEitherError :: Show a => (Priority -> String -> IO ()) -> String -> Either a b -> IO (Maybe b) logEitherError :: (Priority -> FilePath -> IO ()) -> FilePath -> Either a b -> IO (Maybe b) logEitherError logger :: Priority -> FilePath -> IO () logger message :: FilePath 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 (\err :: a err -> Priority -> FilePath -> IO () logger Priority ERROR (FilePath message FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ a -> FilePath forall a. Show a => a -> FilePath 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 :: b -> Either MethodError b -> Either MethodError b exemptUnknownMethod def :: b def eitherV :: Either MethodError b eitherV = case Either MethodError b eitherV of Right _ -> 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 :: b -> Either MethodError b -> Either MethodError b exemptAll def :: b def eitherV :: Either MethodError b eitherV = case Either MethodError b eitherV of Right _ -> Either MethodError b eitherV Left _ -> 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) <..> :: (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) fn :: a -> IO b fn <<$>> :: (a -> IO b) -> Maybe a -> IO (Maybe b) <<$>> m :: 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 :: (i -> m a) -> (i -> m b) -> i -> m (a, b) forkM a :: i -> m a a b :: i -> m b b i :: 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 :: (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 >>=/ :: m a -> (a -> m b) -> m a (>>=/) 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 client bus :: BusName bus path :: ObjectPath path = (FilePath -> Maybe Object) -> Either MethodError FilePath -> 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 "/" (Text -> Maybe Object) -> (FilePath -> Text) -> FilePath -> Maybe Object forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> Text pack) (Either MethodError FilePath -> Either MethodError (Maybe Object)) -> IO (Either MethodError FilePath) -> IO (Either MethodError (Maybe Object)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Client -> BusName -> ObjectPath -> IO (Either MethodError FilePath) introspect Client client BusName bus ObjectPath path findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM :: (a -> m Bool) -> [a] -> m (Maybe a) findM p :: 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 p :: a -> m Bool p (x :: a x:xs :: [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)