    {-# 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. HasCallStack => [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 <- String -> ObjectPath -> Q Object
    getIntrospectionObjectFromFile String
    filepath ObjectPath
    "/"
      let interface = [Interface] -> Interface
    forall a. HasCallStack => [a] -> a
    head ([Interface] -> Interface) -> [Interface] -> Interface
    forall a b. (a -> b) -> a -> b
    $ Object -> [Interface]
    I.objectInterfaces Object
    object
          actualObjectPath = Object -> ObjectPath
    I.objectPath Object
    object
          realParams =
            if Bool
    useObjectPath
            then GenerationParams
    params { G.genObjectPath = Just actualObjectPath }
            else GenerationParams
    params
      (++) <$> G.generateClient realParams interface <*>
               G.generateSignalsFromInterface realParams 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 a b. m a -> (a -> m b) -> m b
    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 a. a -> m a
    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 a b. (a -> b) -> IO a -> 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 a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe b -> IO (Maybe b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing) (Maybe b -> IO (Maybe b)
    forall a. a -> IO a
    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 a b. (a -> b) -> f a -> 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 a b. (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)
    forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe 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
        r1 <- i -> m a
    a i
    i
        r2 <- b i
        return (r1, 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 a b. (a -> b) -> ((i -> m a) -> a) -> (i -> m a) -> b
    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 a b. (a -> b) -> ((i -> m b) -> a) -> (i -> m b) -> b
    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 a b. (a -> b) -> (i -> a) -> i -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (((a, b) -> a) -> m (a, b) -> m a
    forall a b. (a -> b) -> m a -> m b
    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 a b. m a -> (a -> m b) -> m b
    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 a. 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 b c d. (b -> c) -> Either d b -> Either d c
    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 a. a -> m 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 a. a -> m 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)