    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PatternGuards         #-}
    {-# LANGUAGE CPP                   #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.ShowWName
    -- Description :  A layout modifier that will show the workspace name.
    -- Copyright   :  (c) Andrea Rossato 2007
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  andrea.rossato@unibz.it
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This is a layout modifier that will show the workspace name
    -----------------------------------------------------------------------------

    module XMonad.Layout.ShowWName
        ( -- * Usage
          -- $usage
          showWName
        , showWName'
        , def
        , SWNConfig(..)
        , ShowWName
        ) where

    import XMonad
    import qualified XMonad.StackSet as S
    import XMonad.Layout.LayoutModifier
    import XMonad.Util.Font
    import XMonad.Util.Timer
    import XMonad.Util.XUtils

    -- $usage
    -- You can use this module with the following in your
    -- @xmonad.hs@:
    --
    -- > import XMonad.Layout.ShowWName
    -- > myLayout = layoutHook def
    -- > main = xmonad def { layoutHook = showWName myLayout }
    --
    -- For more detailed instructions on editing the layoutHook see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
    -- "XMonad.Doc.Extending#Editing_the_layout_hook".

    -- | A layout modifier to show the workspace name when switching
    showWName :: l a -> ModifiedLayout ShowWName l a
    showWName :: forall (l :: * -> *) a. l a -> ModifiedLayout ShowWName l a
    showWName = ShowWName a -> l a -> ModifiedLayout ShowWName l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (Bool -> SWNConfig -> ShowWNState -> ShowWName a
    forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
    SWN Bool
    True SWNConfig
    forall a. Default a => a
    def ShowWNState
    forall a. Maybe a
    Nothing)

    -- | A layout modifier to show the workspace name when switching. It
    -- is possible to provide a custom configuration.
    showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a
    showWName' :: forall (l :: * -> *) a.
    SWNConfig -> l a -> ModifiedLayout ShowWName l a
    showWName' SWNConfig
    c = ShowWName a -> l a -> ModifiedLayout ShowWName l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (Bool -> SWNConfig -> ShowWNState -> ShowWName a
    forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
    SWN Bool
    True SWNConfig
    c ShowWNState
    forall a. Maybe a
    Nothing)

    type ShowWNState = Maybe (TimerId, Window)
    data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (ReadPrec [ShowWName a]
    ReadPrec (ShowWName a)
    Int -> ReadS (ShowWName a)
    ReadS [ShowWName a]
    (Int -> ReadS (ShowWName a))
    -> ReadS [ShowWName a]
    -> ReadPrec (ShowWName a)
    -> ReadPrec [ShowWName a]
    -> Read (ShowWName a)
    forall a. ReadPrec [ShowWName a]
    forall a. ReadPrec (ShowWName a)
    forall a. Int -> ReadS (ShowWName a)
    forall a. ReadS [ShowWName a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (ShowWName a)
    readsPrec :: Int -> ReadS (ShowWName a)
    $creadList :: forall a. ReadS [ShowWName a]
    readList :: ReadS [ShowWName a]
    $creadPrec :: forall a. ReadPrec (ShowWName a)
    readPrec :: ReadPrec (ShowWName a)
    $creadListPrec :: forall a. ReadPrec [ShowWName a]
    readListPrec :: ReadPrec [ShowWName a]
    Read, Int -> ShowWName a -> ShowS
    [ShowWName a] -> ShowS
    ShowWName a -> String
    (Int -> ShowWName a -> ShowS)
    -> (ShowWName a -> String)
    -> ([ShowWName a] -> ShowS)
    -> Show (ShowWName a)
    forall a. Int -> ShowWName a -> ShowS
    forall a. [ShowWName a] -> ShowS
    forall a. ShowWName a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> ShowWName a -> ShowS
    showsPrec :: Int -> ShowWName a -> ShowS
    $cshow :: forall a. ShowWName a -> String
    show :: ShowWName a -> String
    $cshowList :: forall a. [ShowWName a] -> ShowS
    showList :: [ShowWName a] -> ShowS
    Show)

    data SWNConfig =
        SWNC { SWNConfig -> String
    swn_font    :: String   -- ^ Font name
             , SWNConfig -> String
    swn_bgcolor :: String   -- ^ Background color
             , SWNConfig -> String
    swn_color   :: String   -- ^ String color
             , SWNConfig -> Rational
    swn_fade    :: Rational -- ^ Time in seconds of the name visibility
        } deriving (ReadPrec [SWNConfig]
    ReadPrec SWNConfig
    Int -> ReadS SWNConfig
    ReadS [SWNConfig]
    (Int -> ReadS SWNConfig)
    -> ReadS [SWNConfig]
    -> ReadPrec SWNConfig
    -> ReadPrec [SWNConfig]
    -> Read SWNConfig
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS SWNConfig
    readsPrec :: Int -> ReadS SWNConfig
    $creadList :: ReadS [SWNConfig]
    readList :: ReadS [SWNConfig]
    $creadPrec :: ReadPrec SWNConfig
    readPrec :: ReadPrec SWNConfig
    $creadListPrec :: ReadPrec [SWNConfig]
    readListPrec :: ReadPrec [SWNConfig]
    Read, Int -> SWNConfig -> ShowS
    [SWNConfig] -> ShowS
    SWNConfig -> String
    (Int -> SWNConfig -> ShowS)
    -> (SWNConfig -> String)
    -> ([SWNConfig] -> ShowS)
    -> Show SWNConfig
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SWNConfig -> ShowS
    showsPrec :: Int -> SWNConfig -> ShowS
    $cshow :: SWNConfig -> String
    show :: SWNConfig -> String
    $cshowList :: [SWNConfig] -> ShowS
    showList :: [SWNConfig] -> ShowS
    Show)

    instance Default SWNConfig where
      def :: SWNConfig
    def =
    #ifdef XFT
        SWNC { swn_font :: String
    swn_font    = String
    "xft:monospace-20"
    #else
        SWNC { swn_font    = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
    #endif
             , swn_bgcolor :: String
    swn_bgcolor = String
    "black"
             , swn_color :: String
    swn_color   = String
    "white"
             , swn_fade :: Rational
    swn_fade    = Rational
    1
             }

    instance LayoutModifier ShowWName a where
        redoLayout :: ShowWName a
    -> Rectangle
    -> Maybe (Stack a)
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    redoLayout      ShowWName a
    sn Rectangle
    r Maybe (Stack a)
    _ = ShowWName a
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a.
    ShowWName a
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    doShow ShowWName a
    sn Rectangle
    r

        handleMess :: ShowWName a -> SomeMessage -> X (Maybe (ShowWName a))
    handleMess (SWN Bool
    _ SWNConfig
    c (Just (Int
    i,Window
    w))) SomeMessage
    m
            | Just Event
    e    <- SomeMessage -> Maybe Event
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = Int -> Event -> X (Maybe (ShowWName a)) -> X (Maybe (ShowWName a))
    forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
    handleTimer Int
    i Event
    e (Window -> X ()
    deleteWindow Window
    w X () -> X (Maybe (ShowWName a)) -> X (Maybe (ShowWName a))
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (ShowWName a) -> X (Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ShowWName a)
    forall a. Maybe a
    Nothing)
            | Just LayoutMessages
    Hide <- SomeMessage -> Maybe LayoutMessages
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = do Window -> X ()
    deleteWindow Window
    w
                                              Maybe (ShowWName a) -> X (Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (ShowWName a) -> X (Maybe (ShowWName a)))
    -> (ShowWName a -> Maybe (ShowWName a))
    -> ShowWName a
    -> X (Maybe (ShowWName a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowWName a -> Maybe (ShowWName a)
    forall a. a -> Maybe a
    Just (ShowWName a -> X (Maybe (ShowWName a)))
    -> ShowWName a -> X (Maybe (ShowWName a))
    forall a b. (a -> b) -> a -> b
    $ Bool -> SWNConfig -> ShowWNState -> ShowWName a
    forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
    SWN Bool
    True SWNConfig
    c ShowWNState
    forall a. Maybe a
    Nothing

        handleMess (SWN Bool
    _ SWNConfig
    c ShowWNState
    s) SomeMessage
    m
            | Just LayoutMessages
    Hide <- SomeMessage -> Maybe LayoutMessages
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = Maybe (ShowWName a) -> X (Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (ShowWName a) -> X (Maybe (ShowWName a)))
    -> (ShowWName a -> Maybe (ShowWName a))
    -> ShowWName a
    -> X (Maybe (ShowWName a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowWName a -> Maybe (ShowWName a)
    forall a. a -> Maybe a
    Just (ShowWName a -> X (Maybe (ShowWName a)))
    -> ShowWName a -> X (Maybe (ShowWName a))
    forall a b. (a -> b) -> a -> b
    $ Bool -> SWNConfig -> ShowWNState -> ShowWName a
    forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
    SWN Bool
    True SWNConfig
    c ShowWNState
    s
            | Bool
    otherwise                  = Maybe (ShowWName a) -> X (Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ShowWName a)
    forall a. Maybe a
    Nothing

    doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
    doShow :: forall a.
    ShowWName a
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    doShow (SWN Bool
    True  SWNConfig
    c (Just (Int
    _,Window
    w))) Rectangle
    r [(a, Rectangle)]
    wrs = Window -> X ()
    deleteWindow Window
    w X ()
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> SWNConfig
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a.
    SWNConfig
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    flashName SWNConfig
    c Rectangle
    r [(a, Rectangle)]
    wrs
    doShow (SWN Bool
    True  SWNConfig
    c  ShowWNState
    Nothing    ) Rectangle
    r [(a, Rectangle)]
    wrs = SWNConfig
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a.
    SWNConfig
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    flashName SWNConfig
    c Rectangle
    r [(a, Rectangle)]
    wrs
    doShow (SWN Bool
    False SWNConfig
    _  ShowWNState
    _          ) Rectangle
    _ [(a, Rectangle)]
    wrs = ([(a, Rectangle)], Maybe (ShowWName a))
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(a, Rectangle)]
    wrs, Maybe (ShowWName a)
    forall a. Maybe a
    Nothing)

    flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
    flashName :: forall a.
    SWNConfig
    -> Rectangle
    -> [(a, Rectangle)]
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    flashName SWNConfig
    c (Rectangle Position
    sx Position
    sy Dimension
    wh Dimension
    ht) [(a, Rectangle)]
    wrs = do
      Display
    d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      String
    n <- (WindowSet -> X String) -> X String
    forall a. (WindowSet -> X a) -> X a
    withWindowSet (String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String)
    -> (WindowSet -> String) -> WindowSet -> X String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> String
    forall i l a s sd. StackSet i l a s sd -> i
    S.currentTag)
      XMonadFont
    f <- String -> X XMonadFont
    initXMF (SWNConfig -> String
    swn_font SWNConfig
    c)
      Int
    width <- (\Int
    w -> Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    n) (Int -> Int) -> X Int -> X Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> XMonadFont -> String -> X Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    d XMonadFont
    f String
    n
      (Position
    as,Position
    ds) <- XMonadFont -> String -> X (Position, Position)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Position, Position)
    textExtentsXMF XMonadFont
    f String
    n
      let hight :: Position
    hight = Position
    as Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    ds
          y :: Position
    y     = Position -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    sy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    hight Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    2) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2
          x :: Int
    x     = Position -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    sx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    wh Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
      Window
    w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
    createNewWindow (Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    x) (Position -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    y) (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    width) (Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    hight)) Maybe Window
    forall a. Maybe a
    Nothing String
    "" Bool
    True
      Window -> X ()
    showWindow Window
    w
      Window
    -> XMonadFont
    -> Dimension
    -> Dimension
    -> Dimension
    -> String
    -> String
    -> String
    -> String
    -> [Align]
    -> [String]
    -> X ()
    paintAndWrite Window
    w XMonadFont
    f (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    width) (Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    hight) Dimension
    0 (SWNConfig -> String
    swn_bgcolor SWNConfig
    c) String
    "" (SWNConfig -> String
    swn_color SWNConfig
    c) (SWNConfig -> String
    swn_bgcolor SWNConfig
    c) [Align
    AlignCenter] [String
    n]
      XMonadFont -> X ()
    releaseXMF XMonadFont
    f
      Int
    i <- Rational -> X Int
    startTimer (SWNConfig -> Rational
    swn_fade SWNConfig
    c)
      ([(a, Rectangle)], Maybe (ShowWName a))
    -> X ([(a, Rectangle)], Maybe (ShowWName a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(a, Rectangle)]
    wrs, ShowWName a -> Maybe (ShowWName a)
    forall a. a -> Maybe a
    Just (ShowWName a -> Maybe (ShowWName a))
    -> ShowWName a -> Maybe (ShowWName a)
    forall a b. (a -> b) -> a -> b
    $ Bool -> SWNConfig -> ShowWNState -> ShowWName a
    forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
    SWN Bool
    False SWNConfig
    c (ShowWNState -> ShowWName a) -> ShowWNState -> ShowWName a
    forall a b. (a -> b) -> a -> b
    $ (Int, Window) -> ShowWNState
    forall a. a -> Maybe a
    Just (Int
    i,Window
    w))