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 :: Ptr a -> Int -> IO (Ptr Word8)
pixelsARGBToBytesABGR ptr :: Ptr a
ptr size :: 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
* 4)
  let writeIndex :: Int -> IO ()
writeIndex i :: 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` (-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` (-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` (-24)
            baseTarget :: Int
baseTarget = 4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i
            doPoke :: Int -> Word8 -> IO ()
doPoke offset :: 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
.&. 0xFF)
        Int -> Word8 -> IO ()
doPoke 0 Word8
r
        Int -> Word8 -> IO ()
doPoke 1 Word8
g
        Int -> Word8 -> IO ()
doPoke 2 Word8
b
        Int -> Word8 -> IO ()
doPoke 3 Word8
a
      writeIndexAndNext :: Int -> IO ()
writeIndexAndNext i :: Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = Int -> IO ()
writeIndex Int
i IO () -> IO () -> IO ()
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
+ 1)
  Int -> IO ()
writeIndexAndNext 0
  Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
target

selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon
selectEWMHIcon :: Int32 -> [EWMHIcon] -> Maybe EWMHIcon
selectEWMHIcon imgSize :: Int32
imgSize icons :: [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 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 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 size :: 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)
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 PixelsWordType
ewmhPixelsARGB = Ptr PixelsWordType
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
* 4
  Ptr Word8
wPtr <- Ptr PixelsWordType -> Int -> IO (Ptr Word8)
forall a.
(Storable a, Bits a, Num a, Integral a) =>
Ptr a -> Int -> IO (Ptr Word8)
pixelsARGBToBytesABGR Ptr PixelsWordType
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 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 -> PixelsWordType -> X11Property (Maybe Pixbuf)
getIconPixBufFromEWMH size :: Int32
size x11WindowId :: PixelsWordType
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
$ PixelsWordType -> ReaderT X11Context IO (Maybe EWMHIconData)
getWindowIconsData PixelsWordType
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 (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 :: Int32 -> Word32 -> m Pixbuf
pixBufFromColor imgSize :: Int32
imgSize c :: 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 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 (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
pixbuf

getDirectoryEntryByClass
  :: String
  -> TaffyIO (Maybe DesktopEntry)
getDirectoryEntryByClass :: String -> TaffyIO (Maybe DesktopEntry)
getDirectoryEntryByClass klass :: 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 (t :: * -> *) a. Foldable t => t a -> Int
length [DesktopEntry]
entries Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "System.Taffybar.WindowIcon" Priority
INFO "Multiple entries for: %s"
       (String
klass, [DesktopEntry]
entries)
  Maybe DesktopEntry -> TaffyIO (Maybe DesktopEntry)
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 :: (p -> String -> m (Maybe a)) -> p -> String -> m (Maybe a)
getWindowIconForAllClasses doOnClass :: p -> String -> m (Maybe a)
doOnClass size :: p
size klass :: String
klass =
  (m (Maybe a) -> String -> m (Maybe a))
-> m (Maybe a) -> [String] -> m (Maybe a)
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 (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 soFar :: m (Maybe a)
soFar theClass :: 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 size :: Int32
size klass :: 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 (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 "System.Taffybar.WindowIcon" Priority
DEBUG
                   "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 (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 size :: Int32
size klass :: String
klass = Int32 -> Text -> IO (Maybe Pixbuf)
loadPixbufByName Int32
size (String -> Text
T.pack String
klass)

getPixBufFromChromeData :: X11Window -> TaffyIO (Maybe Gdk.Pixbuf)
getPixBufFromChromeData :: PixelsWordType -> TaffyIO (Maybe Pixbuf)
getPixBufFromChromeData window :: PixelsWordType
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Map Int ChromeTabImageData)
-> ReaderT Context IO (Map Int ChromeTabImageData)
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 x11LookupMapVar :: MVar (Map PixelsWordType Int)
x11LookupMapVar <- TaffyIO X11WindowToChromeTabId
getX11WindowToChromeTabId
  Map PixelsWordType Int
x11LookupMap <- IO (Map PixelsWordType Int)
-> ReaderT Context IO (Map PixelsWordType Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Map PixelsWordType Int)
 -> ReaderT Context IO (Map PixelsWordType Int))
-> IO (Map PixelsWordType Int)
-> ReaderT Context IO (Map PixelsWordType Int)
forall a b. (a -> b) -> a -> b
$ MVar (Map PixelsWordType Int) -> IO (Map PixelsWordType Int)
forall a. MVar a -> IO a
readMVar MVar (Map PixelsWordType Int)
x11LookupMapVar
  Maybe Pixbuf -> TaffyIO (Maybe Pixbuf)
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
<$> (PixelsWordType -> Map PixelsWordType Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PixelsWordType
window Map PixelsWordType Int
x11LookupMap Maybe Int
-> (Int -> Maybe ChromeTabImageData) -> Maybe ChromeTabImageData
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)