module System.Taffybar.WindowIcon where

import           Control.Concurrent
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Data.Bits
import           Data.Int
import           Data.List
import qualified Data.Map as M
import           Data.Maybe
import qualified Data.MultiMap as MM
import           Data.Ord
import qualified Data.Text as T
import           Data.Word
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Array
import           Foreign.Ptr
import           Foreign.Storable
import qualified GI.GdkPixbuf.Enums as Gdk
import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
import           System.Log.Logger
import           System.Taffybar.Context
import           System.Taffybar.Hooks
import           System.Taffybar.Information.Chrome
import           System.Taffybar.Information.EWMHDesktopInfo
import           System.Taffybar.Information.X11DesktopInfo
import           System.Environment.XDG.DesktopEntry
import           System.Taffybar.Util
import           System.Taffybar.Widget.Util

type ColorRGBA = Word32

-- | Convert a C array of integer pixels in the ARGB format to the ABGR format.
-- Returns an unmanged Ptr that points to a block of memory that must be freed
-- manually.
pixelsARGBToBytesABGR
  :: (Storable a, Bits a, Num a, Integral a)
  => Ptr a -> Int -> IO (Ptr Word8)
pixelsARGBToBytesABGR :: forall a.
(Storable a, Bits a, Num a, Integral a) =>
Ptr a -> Int -> IO (Ptr Word8)
pixelsARGBToBytesABGR Ptr a
ptr Int
size = do
  Ptr Word8
target <- Int -> IO (Ptr Word8)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
  let writeIndex :: Int -> IO ()
writeIndex Int
i = do
        a
bits <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
i
        let b :: Word8
b = a -> Word8
toByte a
bits
            g :: Word8
g = a -> Word8
toByte (a -> Word8) -> a -> Word8
forall a b. (a -> b) -> a -> b
$ a
bits a -> Int -> a
forall a. Bits a => a -> Int -> a
`shift` (-Int
8)
            r :: Word8
r = a -> Word8
toByte (a -> Word8) -> a -> Word8
forall a b. (a -> b) -> a -> b
$ a
bits a -> Int -> a
forall a. Bits a => a -> Int -> a
`shift` (-Int
16)
            a :: Word8
a = a -> Word8
toByte (a -> Word8) -> a -> Word8
forall a b. (a -> b) -> a -> b
$ a
bits a -> Int -> a
forall a. Bits a => a -> Int -> a
`shift` (-Int
24)
            baseTarget :: Int
baseTarget = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i
            doPoke :: Int -> Word8 -> IO ()
doPoke Int
offset = Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
target (Int
baseTarget Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
            toByte :: a -> Word8
toByte = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word8) -> (a -> a) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFF)
        Int -> Word8 -> IO ()
doPoke Int
0 Word8
r
        Int -> Word8 -> IO ()
doPoke Int
1 Word8
g
        Int -> Word8 -> IO ()
doPoke Int
2 Word8
b
        Int -> Word8 -> IO ()
doPoke Int
3 Word8
a
      writeIndexAndNext :: Int -> IO ()
writeIndexAndNext Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = Int -> IO ()
writeIndex Int
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
writeIndexAndNext (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> IO ()
writeIndexAndNext Int
0
  Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
target

selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon
selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon
selectEWMHIcon Int32
imgSize [EWMHIcon]
icons = [EWMHIcon] -> Maybe EWMHIcon
forall a. [a] -> Maybe a
listToMaybe [EWMHIcon]
prefIcon
  where
    sortedIcons :: [EWMHIcon]
sortedIcons = (EWMHIcon -> EWMHIcon -> Ordering) -> [EWMHIcon] -> [EWMHIcon]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((EWMHIcon -> Int) -> EWMHIcon -> EWMHIcon -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing EWMHIcon -> Int
ewmhHeight) [EWMHIcon]
icons
    smallestLargerIcon :: [EWMHIcon]
smallestLargerIcon =
      Int -> [EWMHIcon] -> [EWMHIcon]
forall a. Int -> [a] -> [a]
take Int
1 ([EWMHIcon] -> [EWMHIcon]) -> [EWMHIcon] -> [EWMHIcon]
forall a b. (a -> b) -> a -> b
$ (EWMHIcon -> Bool) -> [EWMHIcon] -> [EWMHIcon]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
imgSize) (Int -> Bool) -> (EWMHIcon -> Int) -> EWMHIcon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EWMHIcon -> Int
ewmhHeight) [EWMHIcon]
sortedIcons
    largestIcon :: [EWMHIcon]
largestIcon = Int -> [EWMHIcon] -> [EWMHIcon]
forall a. Int -> [a] -> [a]
take Int
1 ([EWMHIcon] -> [EWMHIcon]) -> [EWMHIcon] -> [EWMHIcon]
forall a b. (a -> b) -> a -> b
$ [EWMHIcon] -> [EWMHIcon]
forall a. [a] -> [a]
reverse [EWMHIcon]
sortedIcons
    prefIcon :: [EWMHIcon]
prefIcon = [EWMHIcon]
smallestLargerIcon [EWMHIcon] -> [EWMHIcon] -> [EWMHIcon]
forall a. [a] -> [a] -> [a]
++ [EWMHIcon]
largestIcon

getPixbufFromEWMHIcons :: Int32 -> [EWMHIcon] -> IO (Maybe Gdk.Pixbuf)
getPixbufFromEWMHIcons :: Int32 -> [EWMHIcon] -> IO (Maybe Pixbuf)
getPixbufFromEWMHIcons Int32
size = (EWMHIcon -> IO Pixbuf) -> Maybe EWMHIcon -> IO (Maybe Pixbuf)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse EWMHIcon -> IO Pixbuf
pixBufFromEWMHIcon (Maybe EWMHIcon -> IO (Maybe Pixbuf))
-> ([EWMHIcon] -> Maybe EWMHIcon)
-> [EWMHIcon]
-> IO (Maybe Pixbuf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> [EWMHIcon] -> Maybe EWMHIcon
selectEWMHIcon Int32
size

-- | Create a pixbuf from the pixel data in an EWMHIcon.
pixBufFromEWMHIcon :: EWMHIcon -> IO Gdk.Pixbuf
pixBufFromEWMHIcon :: EWMHIcon -> IO Pixbuf
pixBufFromEWMHIcon EWMHIcon {ewmhWidth :: EWMHIcon -> Int
ewmhWidth = Int
w, ewmhHeight :: EWMHIcon -> Int
ewmhHeight = Int
h, ewmhPixelsARGB :: EWMHIcon -> Ptr X11Window
ewmhPixelsARGB = Ptr X11Window
px} = do
  let width :: Int32
width = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
      height :: Int32
height = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
      rowStride :: Int32
rowStride = Int32
width Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4
  Ptr Word8
wPtr <- Ptr X11Window -> Int -> IO (Ptr Word8)
forall a.
(Storable a, Bits a, Num a, Integral a) =>
Ptr a -> Int -> IO (Ptr Word8)
pixelsARGBToBytesABGR Ptr X11Window
px (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h)
  Ptr Word8
-> Colorspace
-> Bool
-> Int32
-> Int32
-> Int32
-> Int32
-> Maybe PixbufDestroyNotify
-> IO Pixbuf
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr Word8
-> Colorspace
-> Bool
-> Int32
-> Int32
-> Int32
-> Int32
-> Maybe PixbufDestroyNotify
-> m Pixbuf
Gdk.pixbufNewFromData Ptr Word8
wPtr Colorspace
Gdk.ColorspaceRgb Bool
True Int32
8
     Int32
width Int32
height Int32
rowStride (PixbufDestroyNotify -> Maybe PixbufDestroyNotify
forall a. a -> Maybe a
Just PixbufDestroyNotify
forall a. Ptr a -> IO ()
free)

getIconPixBufFromEWMH :: Int32 -> X11Window -> X11Property (Maybe Gdk.Pixbuf)
getIconPixBufFromEWMH :: Int32 -> X11Window -> X11Property (Maybe Pixbuf)
getIconPixBufFromEWMH Int32
size X11Window
x11WindowId = MaybeT (ReaderT X11Context IO) Pixbuf -> X11Property (Maybe Pixbuf)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ReaderT X11Context IO) Pixbuf
 -> X11Property (Maybe Pixbuf))
-> MaybeT (ReaderT X11Context IO) Pixbuf
-> X11Property (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
  EWMHIconData
ewmhData <- ReaderT X11Context IO (Maybe EWMHIconData)
-> MaybeT (ReaderT X11Context IO) EWMHIconData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT X11Context IO (Maybe EWMHIconData)
 -> MaybeT (ReaderT X11Context IO) EWMHIconData)
-> ReaderT X11Context IO (Maybe EWMHIconData)
-> MaybeT (ReaderT X11Context IO) EWMHIconData
forall a b. (a -> b) -> a -> b
$ X11Window -> ReaderT X11Context IO (Maybe EWMHIconData)
getWindowIconsData X11Window
x11WindowId
  X11Property (Maybe Pixbuf) -> MaybeT (ReaderT X11Context IO) Pixbuf
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (X11Property (Maybe Pixbuf)
 -> MaybeT (ReaderT X11Context IO) Pixbuf)
-> X11Property (Maybe Pixbuf)
-> MaybeT (ReaderT X11Context IO) Pixbuf
forall a b. (a -> b) -> a -> b
$ IO (Maybe Pixbuf) -> X11Property (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Pixbuf) -> X11Property (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> X11Property (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ EWMHIconData
-> ([EWMHIcon] -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
forall a. EWMHIconData -> ([EWMHIcon] -> IO a) -> IO a
withEWMHIcons EWMHIconData
ewmhData (Int32 -> [EWMHIcon] -> IO (Maybe Pixbuf)
getPixbufFromEWMHIcons Int32
size)

-- | Create a pixbuf with the indicated RGBA color.
pixBufFromColor
  :: MonadIO m
  => Int32 -> Word32 -> m Gdk.Pixbuf
pixBufFromColor :: forall (m :: * -> *). MonadIO m => Int32 -> Word32 -> m Pixbuf
pixBufFromColor Int32
imgSize Word32
c = do
  Pixbuf
pixbuf <- Maybe Pixbuf -> Pixbuf
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Pixbuf -> Pixbuf) -> m (Maybe Pixbuf) -> m Pixbuf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Colorspace -> Bool -> Int32 -> Int32 -> Int32 -> m (Maybe Pixbuf)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Colorspace -> Bool -> Int32 -> Int32 -> Int32 -> m (Maybe Pixbuf)
Gdk.pixbufNew Colorspace
Gdk.ColorspaceRgb Bool
True Int32
8 Int32
imgSize Int32
imgSize
  Pixbuf -> Word32 -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPixbuf a) =>
a -> Word32 -> m ()
Gdk.pixbufFill Pixbuf
pixbuf Word32
c
  Pixbuf -> m Pixbuf
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
pixbuf

getDirectoryEntryByClass
  :: String
  -> TaffyIO (Maybe DesktopEntry)
getDirectoryEntryByClass :: String -> TaffyIO (Maybe DesktopEntry)
getDirectoryEntryByClass String
klass = do
  [DesktopEntry]
entries <- String -> MultiMap String DesktopEntry -> [DesktopEntry]
forall k a. Ord k => k -> MultiMap k a -> [a]
MM.lookup String
klass (MultiMap String DesktopEntry -> [DesktopEntry])
-> ReaderT Context IO (MultiMap String DesktopEntry)
-> ReaderT Context IO [DesktopEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Context IO (MultiMap String DesktopEntry)
getDirectoryEntriesByClassName
  Bool -> ReaderT Context IO () -> ReaderT Context IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([DesktopEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DesktopEntry]
entries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ReaderT Context IO () -> ReaderT Context IO ())
-> ReaderT Context IO () -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$
       String
-> Priority
-> String
-> (String, [DesktopEntry])
-> ReaderT Context IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
String -> Priority -> String -> t -> m ()
logPrintF String
"System.Taffybar.WindowIcon" Priority
INFO String
"Multiple entries for: %s"
       (String
klass, [DesktopEntry]
entries)
  Maybe DesktopEntry -> TaffyIO (Maybe DesktopEntry)
forall a. a -> ReaderT Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DesktopEntry -> TaffyIO (Maybe DesktopEntry))
-> Maybe DesktopEntry -> TaffyIO (Maybe DesktopEntry)
forall a b. (a -> b) -> a -> b
$ [DesktopEntry] -> Maybe DesktopEntry
forall a. [a] -> Maybe a
listToMaybe [DesktopEntry]
entries

getWindowIconForAllClasses
  :: Monad m
  => (p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)
getWindowIconForAllClasses :: forall (m :: * -> *) p a.
Monad m =>
(p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)
getWindowIconForAllClasses p -> String -> m (Maybe a)
doOnClass p
size String
klass =
  (m (Maybe a) -> String -> m (Maybe a))
-> m (Maybe a) -> [String] -> m (Maybe a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m (Maybe a) -> String -> m (Maybe a)
combine (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) ([String] -> m (Maybe a)) -> [String] -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> [String]
parseWindowClasses String
klass
  where
    combine :: m (Maybe a) -> String -> m (Maybe a)
combine m (Maybe a)
soFar String
theClass =
      m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
maybeTCombine m (Maybe a)
soFar (p -> String -> m (Maybe a)
doOnClass p
size String
theClass)

getWindowIconFromDesktopEntryByClasses ::
     Int32 -> String -> TaffyIO (Maybe Gdk.Pixbuf)
getWindowIconFromDesktopEntryByClasses :: Int32 -> String -> TaffyIO (Maybe Pixbuf)
getWindowIconFromDesktopEntryByClasses =
  (Int32 -> String -> TaffyIO (Maybe Pixbuf))
-> Int32 -> String -> TaffyIO (Maybe Pixbuf)
forall (m :: * -> *) p a.
Monad m =>
(p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)
getWindowIconForAllClasses Int32 -> String -> TaffyIO (Maybe Pixbuf)
getWindowIconFromDesktopEntryByClass
  where getWindowIconFromDesktopEntryByClass :: Int32 -> String -> TaffyIO (Maybe Pixbuf)
getWindowIconFromDesktopEntryByClass Int32
size String
klass =
          MaybeT (ReaderT Context IO) Pixbuf -> TaffyIO (Maybe Pixbuf)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ReaderT Context IO) Pixbuf -> TaffyIO (Maybe Pixbuf))
-> MaybeT (ReaderT Context IO) Pixbuf -> TaffyIO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
            DesktopEntry
entry <- TaffyIO (Maybe DesktopEntry)
-> MaybeT (ReaderT Context IO) DesktopEntry
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (TaffyIO (Maybe DesktopEntry)
 -> MaybeT (ReaderT Context IO) DesktopEntry)
-> TaffyIO (Maybe DesktopEntry)
-> MaybeT (ReaderT Context IO) DesktopEntry
forall a b. (a -> b) -> a -> b
$ String -> TaffyIO (Maybe DesktopEntry)
getDirectoryEntryByClass String
klass
            ReaderT Context IO () -> MaybeT (ReaderT Context IO) ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Context IO () -> MaybeT (ReaderT Context IO) ())
-> ReaderT Context IO () -> MaybeT (ReaderT Context IO) ()
forall a b. (a -> b) -> a -> b
$ String
-> Priority -> String -> (String, String) -> ReaderT Context IO ()
forall (m :: * -> *) t.
(MonadIO m, Show t) =>
String -> Priority -> String -> t -> m ()
logPrintF String
"System.Taffybar.WindowIcon" Priority
DEBUG
                   String
"Using desktop entry for icon %s"
                   (DesktopEntry -> String
deFilename DesktopEntry
entry, String
klass)
            TaffyIO (Maybe Pixbuf) -> MaybeT (ReaderT Context IO) Pixbuf
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (TaffyIO (Maybe Pixbuf) -> MaybeT (ReaderT Context IO) Pixbuf)
-> TaffyIO (Maybe Pixbuf) -> MaybeT (ReaderT Context IO) Pixbuf
forall a b. (a -> b) -> a -> b
$ IO (Maybe Pixbuf) -> TaffyIO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Pixbuf) -> TaffyIO (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> TaffyIO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ Int32 -> DesktopEntry -> IO (Maybe Pixbuf)
getImageForDesktopEntry Int32
size DesktopEntry
entry

getWindowIconFromClasses :: Int32 -> String -> IO (Maybe Gdk.Pixbuf)
getWindowIconFromClasses :: Int32 -> String -> IO (Maybe Pixbuf)
getWindowIconFromClasses =
  (Int32 -> String -> IO (Maybe Pixbuf))
-> Int32 -> String -> IO (Maybe Pixbuf)
forall (m :: * -> *) p a.
Monad m =>
(p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)
getWindowIconForAllClasses Int32 -> String -> IO (Maybe Pixbuf)
getWindowIconFromClass
  where getWindowIconFromClass :: Int32 -> String -> IO (Maybe Pixbuf)
getWindowIconFromClass Int32
size String
klass = Int32 -> Text -> IO (Maybe Pixbuf)
loadPixbufByName Int32
size (String -> Text
T.pack String
klass)

getPixBufFromChromeData :: X11Window -> TaffyIO (Maybe Gdk.Pixbuf)
getPixBufFromChromeData :: X11Window -> TaffyIO (Maybe Pixbuf)
getPixBufFromChromeData X11Window
window = do
  Map Int ChromeTabImageData
imageData <- TaffyIO (MVar (Map Int ChromeTabImageData))
getChromeTabImageDataTable TaffyIO (MVar (Map Int ChromeTabImageData))
-> (MVar (Map Int ChromeTabImageData)
    -> ReaderT Context IO (Map Int ChromeTabImageData))
-> ReaderT Context IO (Map Int ChromeTabImageData)
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Map Int ChromeTabImageData)
-> ReaderT Context IO (Map Int ChromeTabImageData)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Map Int ChromeTabImageData)
 -> ReaderT Context IO (Map Int ChromeTabImageData))
-> (MVar (Map Int ChromeTabImageData)
    -> IO (Map Int ChromeTabImageData))
-> MVar (Map Int ChromeTabImageData)
-> ReaderT Context IO (Map Int ChromeTabImageData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Map Int ChromeTabImageData)
-> IO (Map Int ChromeTabImageData)
forall a. MVar a -> IO a
readMVar
  X11WindowToChromeTabId MVar (Map X11Window Int)
x11LookupMapVar <- TaffyIO X11WindowToChromeTabId
getX11WindowToChromeTabId
  Map X11Window Int
x11LookupMap <- IO (Map X11Window Int) -> ReaderT Context IO (Map X11Window Int)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Map X11Window Int) -> ReaderT Context IO (Map X11Window Int))
-> IO (Map X11Window Int) -> ReaderT Context IO (Map X11Window Int)
forall a b. (a -> b) -> a -> b
$ MVar (Map X11Window Int) -> IO (Map X11Window Int)
forall a. MVar a -> IO a
readMVar MVar (Map X11Window Int)
x11LookupMapVar
  Maybe Pixbuf -> TaffyIO (Maybe Pixbuf)
forall a. a -> ReaderT Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Pixbuf -> TaffyIO (Maybe Pixbuf))
-> Maybe Pixbuf -> TaffyIO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ ChromeTabImageData -> Pixbuf
tabImageData (ChromeTabImageData -> Pixbuf)
-> Maybe ChromeTabImageData -> Maybe Pixbuf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (X11Window -> Map X11Window Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup X11Window
window Map X11Window Int
x11LookupMap Maybe Int
-> (Int -> Maybe ChromeTabImageData) -> Maybe ChromeTabImageData
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Map Int ChromeTabImageData -> Maybe ChromeTabImageData)
-> Map Int ChromeTabImageData -> Int -> Maybe ChromeTabImageData
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int ChromeTabImageData -> Maybe ChromeTabImageData
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int ChromeTabImageData
imageData)