    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE PatternGuards #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.FixedAspectRatio
    -- Description :  A layout modifier for user provided per-window aspect ratios.
    -- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Layout modifier for user provided per-window aspect ratios.
    --
    -----------------------------------------------------------------------------

    module XMonad.Layout.FixedAspectRatio
      (
        -- * Usage
        -- $usage
        fixedAspectRatio
      , FixedAspectRatio
      , ManageAspectRatio(..)
      , doFixAspect
      ) where

    import           Control.Arrow
    import qualified Data.Map                      as M
    import           Data.Ratio

    import           XMonad
    import           XMonad.Actions.MessageFeedback
    import           XMonad.Layout.Decoration
    import           XMonad.Layout.LayoutHints

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Layout.FixedAspectRatio
    -- Then add it to your layout:
    --
    -- > myLayout = fixedAspectRatio (0.5, 0.5) $ Tall 1 (3/100) (1/2)  ||| Full ||| etc..
    -- > main = xmonad def { layoutHook = myLayout }
    --
    -- Which will center the (eventually) shrinked windows in their assigned
    -- rectangle.
    --
    -- For a layout modifier that automatically sets the aspect ratio
    -- depending on the size hints (for example for programs like mpv),
    -- see "XMonad.Layout.LayoutHints"
    --
    -- See "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on
    -- the 'layoutHook'.
    --
    -- You also want to add keybindings to set and clear the aspect ratio:
    --
    -- >      -- Set the aspect ratio of the focused window to 16:9
    -- >   ,((modm, xK_a), withFocused $ sendMessage . FixRatio (16 / 9))
    -- >
    -- >      -- Clear the aspect ratio from the focused window
    -- >   ,((modm .|. shiftMask, xK_a), withFocused $ sendMessage . ResetRatio)
    --
    -- There's one caveat: to keep the usage of the modifier simple, it
    -- doesn't remove a window from its cache automatically. Which means
    -- that if you close a program window that has some fixed aspect ratios
    -- and relaunch it, sometimes it'll still have the fixed aspect ratio.
    -- You can try to avoid this by changing they keybinding used to kill
    -- the window:
    --
    -- >  , ((modMask .|. shiftMask, xK_c), withFocused (sendMessage . ResetRatio) >> kill)
    --
    -- See "XMonad.Doc.Extending#Editing_key_bindings" for more info
    -- on customizing the keybindings.
    --
    -- This layout also comes with a 'ManageHook' 'doFixAspect' to
    -- automatically fix the aspect ratio:
    --
    -- > myManageHook = composeOne [
    -- >   title =? "Netflix" <||> className =? "vlc" --> doFixAspect (16 / 9)
    -- >   ...
    -- > ]
    --
    -- Check "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on
    -- customizing the manage hook.

    -- | Similar to 'layoutHintsWithReplacement', but relies on the user to
    -- provide the ratio for each window. @aspectRatio (rx, ry) layout@ will
    -- adapt the sizes of a layout's windows according to the provided aspect
    -- ratio, and position them inside their originally assigned area
    -- according to the @rx@ and @ry@ parameters.
    -- (0, 0) places the window at the top left, (1, 0) at the top right,
    -- (0.5, 0.5) at the center, etc.
    fixedAspectRatio
      :: (Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a
    fixedAspectRatio :: forall (l :: * -> *) a.
    (Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a
    fixedAspectRatio = FixedAspectRatio a -> l a -> ModifiedLayout FixedAspectRatio l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (FixedAspectRatio a -> l a -> ModifiedLayout FixedAspectRatio l a)
    -> ((Double, Double) -> FixedAspectRatio a)
    -> (Double, Double)
    -> l a
    -> ModifiedLayout FixedAspectRatio l a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    forall a.
    Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    FixedAspectRatio Map Window (Ratio Integer)
    forall a. Monoid a => a
    mempty

    data FixedAspectRatio a = FixedAspectRatio (M.Map Window Rational)
                                               (Double, Double)
      deriving (ReadPrec [FixedAspectRatio a]
    ReadPrec (FixedAspectRatio a)
    Int -> ReadS (FixedAspectRatio a)
    ReadS [FixedAspectRatio a]
    (Int -> ReadS (FixedAspectRatio a))
    -> ReadS [FixedAspectRatio a]
    -> ReadPrec (FixedAspectRatio a)
    -> ReadPrec [FixedAspectRatio a]
    -> Read (FixedAspectRatio a)
    forall a. ReadPrec [FixedAspectRatio a]
    forall a. ReadPrec (FixedAspectRatio a)
    forall a. Int -> ReadS (FixedAspectRatio a)
    forall a. ReadS [FixedAspectRatio a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (FixedAspectRatio a)
    readsPrec :: Int -> ReadS (FixedAspectRatio a)
    $creadList :: forall a. ReadS [FixedAspectRatio a]
    readList :: ReadS [FixedAspectRatio a]
    $creadPrec :: forall a. ReadPrec (FixedAspectRatio a)
    readPrec :: ReadPrec (FixedAspectRatio a)
    $creadListPrec :: forall a. ReadPrec [FixedAspectRatio a]
    readListPrec :: ReadPrec [FixedAspectRatio a]
    Read, Int -> FixedAspectRatio a -> ShowS
    [FixedAspectRatio a] -> ShowS
    FixedAspectRatio a -> String
    (Int -> FixedAspectRatio a -> ShowS)
    -> (FixedAspectRatio a -> String)
    -> ([FixedAspectRatio a] -> ShowS)
    -> Show (FixedAspectRatio a)
    forall a. Int -> FixedAspectRatio a -> ShowS
    forall a. [FixedAspectRatio a] -> ShowS
    forall a. FixedAspectRatio a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> FixedAspectRatio a -> ShowS
    showsPrec :: Int -> FixedAspectRatio a -> ShowS
    $cshow :: forall a. FixedAspectRatio a -> String
    show :: FixedAspectRatio a -> String
    $cshowList :: forall a. [FixedAspectRatio a] -> ShowS
    showList :: [FixedAspectRatio a] -> ShowS
    Show)

    instance LayoutModifier FixedAspectRatio Window where
      -- | Note: this resembles redoLayout from "XMonad.Layout.LayoutHints".
      -- The only difference is relying on user defined aspect ratios, and
      -- using the 'adj' function defined below instead of 'mkAdjust'
      pureModifier :: FixedAspectRatio Window
    -> Rectangle
    -> Maybe (Stack Window)
    -> [(Window, Rectangle)]
    -> ([(Window, Rectangle)], Maybe (FixedAspectRatio Window))
    pureModifier (FixedAspectRatio Map Window (Ratio Integer)
    ratios (Double, Double)
    placement) Rectangle
    _ (Just Stack Window
    s) [(Window, Rectangle)]
    xs =
        ([(Window, Rectangle)]
    xs', Maybe (FixedAspectRatio Window)
    forall a. Maybe a
    Nothing)
       where
        xs' :: [(Window, Rectangle)]
    xs' =
          ((Window, Rectangle) -> (Window, Rectangle))
    -> [(Window, Rectangle)] -> [(Window, Rectangle)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\x :: (Window, Rectangle)
    x@(Window
    _, Rectangle
    r) -> (Rectangle -> Rectangle)
    -> (Window, Rectangle) -> (Window, Rectangle)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((Double, Double) -> Rectangle -> Rectangle -> Rectangle
    forall r.
    RealFrac r =>
    (r, r) -> Rectangle -> Rectangle -> Rectangle
    placeRectangle (Double, Double)
    placement Rectangle
    r) ((Window, Rectangle) -> (Window, Rectangle))
    -> (Window, Rectangle) -> (Window, Rectangle)
    forall a b. (a -> b) -> a -> b
    $ (Window, Rectangle) -> (Window, Rectangle)
    applyHint (Window, Rectangle)
    x) [(Window, Rectangle)]
    xs
        applyHint :: (Window, Rectangle) -> (Window, Rectangle)
    applyHint (Window
    win, r :: Rectangle
    r@(Rectangle Position
    x Position
    y Dimension
    w Dimension
    h)) =
          let ar :: Maybe (Ratio Integer)
    ar       = Window -> Map Window (Ratio Integer) -> Maybe (Ratio Integer)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Window
    win Map Window (Ratio Integer)
    ratios
              (Dimension
    w', Dimension
    h') = (Dimension, Dimension)
    -> (Ratio Integer -> (Dimension, Dimension))
    -> Maybe (Ratio Integer)
    -> (Dimension, Dimension)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Dimension
    w, Dimension
    h) ((Dimension, Dimension) -> Ratio Integer -> (Dimension, Dimension)
    adj (Dimension
    w, Dimension
    h)) Maybe (Ratio Integer)
    ar
          in  (Window
    win, if Stack Window -> Window -> Bool
    forall a. Eq a => Stack a -> a -> Bool
    isInStack Stack Window
    s Window
    win then Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    w' Dimension
    h' else Rectangle
    r)

      pureModifier FixedAspectRatio Window
    _ Rectangle
    _ Maybe (Stack Window)
    _ [(Window, Rectangle)]
    xs = ([(Window, Rectangle)]
    xs, Maybe (FixedAspectRatio Window)
    forall a. Maybe a
    Nothing)

      handleMess :: FixedAspectRatio Window
    -> SomeMessage -> X (Maybe (FixedAspectRatio Window))
    handleMess (FixedAspectRatio Map Window (Ratio Integer)
    ratios (Double, Double)
    placement) SomeMessage
    mess
        | Just DestroyWindowEvent { ev_window :: Event -> Window
    ev_window = Window
    w } <- SomeMessage -> Maybe Event
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    mess
        = Maybe (FixedAspectRatio Window)
    -> X (Maybe (FixedAspectRatio Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (FixedAspectRatio Window)
     -> X (Maybe (FixedAspectRatio Window)))
    -> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
    -> FixedAspectRatio Window
    -> X (Maybe (FixedAspectRatio Window))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
    forall a. a -> Maybe a
    Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
    -> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
    forall a b. (a -> b) -> a -> b
    $ Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio Window
    forall a.
    Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    FixedAspectRatio (Window -> Map Window (Ratio Integer)
    deleted Window
    w) (Double, Double)
    placement
        | Bool
    otherwise
        = case SomeMessage -> Maybe ManageAspectRatio
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    mess of
          Just (FixRatio Ratio Integer
    r Window
    w) ->
            Maybe (FixedAspectRatio Window)
    -> X (Maybe (FixedAspectRatio Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (FixedAspectRatio Window)
     -> X (Maybe (FixedAspectRatio Window)))
    -> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
    -> FixedAspectRatio Window
    -> X (Maybe (FixedAspectRatio Window))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
    forall a. a -> Maybe a
    Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
    -> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
    forall a b. (a -> b) -> a -> b
    $ Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio Window
    forall a.
    Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    FixedAspectRatio (Window -> Ratio Integer -> Map Window (Ratio Integer)
    inserted Window
    w Ratio Integer
    r) (Double, Double)
    placement
          Just (ResetRatio Window
    w) ->
            Maybe (FixedAspectRatio Window)
    -> X (Maybe (FixedAspectRatio Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (FixedAspectRatio Window)
     -> X (Maybe (FixedAspectRatio Window)))
    -> (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
    -> FixedAspectRatio Window
    -> X (Maybe (FixedAspectRatio Window))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
    forall a. a -> Maybe a
    Just (FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window)))
    -> FixedAspectRatio Window -> X (Maybe (FixedAspectRatio Window))
    forall a b. (a -> b) -> a -> b
    $ Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio Window
    forall a.
    Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    FixedAspectRatio (Window -> Map Window (Ratio Integer)
    deleted Window
    w) (Double, Double)
    placement
          Just (ToggleRatio Ratio Integer
    r Window
    w) ->
            Maybe (FixedAspectRatio Window)
    -> X (Maybe (FixedAspectRatio Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
              (Maybe (FixedAspectRatio Window)
     -> X (Maybe (FixedAspectRatio Window)))
    -> (Maybe (Ratio Integer) -> Maybe (FixedAspectRatio Window))
    -> Maybe (Ratio Integer)
    -> X (Maybe (FixedAspectRatio Window))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FixedAspectRatio Window -> Maybe (FixedAspectRatio Window)
    forall a. a -> Maybe a
    Just
              (FixedAspectRatio Window -> Maybe (FixedAspectRatio Window))
    -> (Maybe (Ratio Integer) -> FixedAspectRatio Window)
    -> Maybe (Ratio Integer)
    -> Maybe (FixedAspectRatio Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Map Window (Ratio Integer)
     -> (Double, Double) -> FixedAspectRatio Window)
    -> (Double, Double)
    -> Map Window (Ratio Integer)
    -> FixedAspectRatio Window
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio Window
    forall a.
    Map Window (Ratio Integer)
    -> (Double, Double) -> FixedAspectRatio a
    FixedAspectRatio (Double, Double)
    placement
              (Map Window (Ratio Integer) -> FixedAspectRatio Window)
    -> (Maybe (Ratio Integer) -> Map Window (Ratio Integer))
    -> Maybe (Ratio Integer)
    -> FixedAspectRatio Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Window (Ratio Integer)
    -> (Ratio Integer -> Map Window (Ratio Integer))
    -> Maybe (Ratio Integer)
    -> Map Window (Ratio Integer)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Window -> Ratio Integer -> Map Window (Ratio Integer)
    inserted Window
    w Ratio Integer
    r) (Map Window (Ratio Integer)
    -> Ratio Integer -> Map Window (Ratio Integer)
    forall a b. a -> b -> a
    const (Map Window (Ratio Integer)
     -> Ratio Integer -> Map Window (Ratio Integer))
    -> Map Window (Ratio Integer)
    -> Ratio Integer
    -> Map Window (Ratio Integer)
    forall a b. (a -> b) -> a -> b
    $ Window -> Map Window (Ratio Integer)
    deleted Window
    w)
              (Maybe (Ratio Integer) -> X (Maybe (FixedAspectRatio Window)))
    -> Maybe (Ratio Integer) -> X (Maybe (FixedAspectRatio Window))
    forall a b. (a -> b) -> a -> b
    $ Window -> Map Window (Ratio Integer) -> Maybe (Ratio Integer)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Window
    w Map Window (Ratio Integer)
    ratios
          Maybe ManageAspectRatio
    _ -> Maybe (FixedAspectRatio Window)
    -> X (Maybe (FixedAspectRatio Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (FixedAspectRatio Window)
    forall a. Maybe a
    Nothing
       where
        inserted :: Window -> Ratio Integer -> Map Window (Ratio Integer)
    inserted Window
    w Ratio Integer
    r = Window
    -> Ratio Integer
    -> Map Window (Ratio Integer)
    -> Map Window (Ratio Integer)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Window
    w Ratio Integer
    r Map Window (Ratio Integer)
    ratios
        deleted :: Window -> Map Window (Ratio Integer)
    deleted Window
    w = Window -> Map Window (Ratio Integer) -> Map Window (Ratio Integer)
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Window
    w Map Window (Ratio Integer)
    ratios

    -- | A 'ManageHook' to set the aspect ratio for newly spawned windows
    doFixAspect
      :: Rational -- ^ The aspect ratio
      -> ManageHook
    doFixAspect :: Ratio Integer -> Query (Endo WindowSet)
    doFixAspect Ratio Integer
    r = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Query Window
    -> (Window -> Query (Endo WindowSet)) -> Query (Endo WindowSet)
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Window
    w -> X () -> Query ()
    forall a. X a -> Query a
    liftX (ManageAspectRatio -> X ()
    forall a. Message a => a -> X ()
    sendMessageWithNoRefreshToCurrent (Ratio Integer -> Window -> ManageAspectRatio
    FixRatio Ratio Integer
    r Window
    w)) Query () -> Query (Endo WindowSet) -> Query (Endo WindowSet)
    forall a b. Query a -> Query b -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Query (Endo WindowSet)
    forall a. Monoid a => a
    mempty

    -- | Calculates the new width and height so they respect the
    -- aspect ratio.
    adj :: (Dimension, Dimension) -> Rational -> (Dimension, Dimension)
    adj :: (Dimension, Dimension) -> Ratio Integer -> (Dimension, Dimension)
    adj (Dimension
    w, Dimension
    h) Ratio Integer
    ar | Ratio Integer
    ar' Ratio Integer -> Ratio Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Ratio Integer
    ar  = (Ratio Integer -> Dimension
    forall b. Integral b => Ratio Integer -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Ratio Integer -> Dimension) -> Ratio Integer -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Ratio Integer
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    h Ratio Integer -> Ratio Integer -> Ratio Integer
    forall a. Num a => a -> a -> a
    * Ratio Integer
    ar, Dimension
    h)
                  | Bool
    otherwise = (Dimension
    w, Ratio Integer -> Dimension
    forall b. Integral b => Ratio Integer -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Ratio Integer -> Dimension) -> Ratio Integer -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Ratio Integer
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    w Ratio Integer -> Ratio Integer -> Ratio Integer
    forall a. Fractional a => a -> a -> a
    / Ratio Integer
    ar)
      where ar' :: Ratio Integer
    ar' = Dimension -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    w Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    % Dimension -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    h

    --- Message handling
    data ManageAspectRatio =
        FixRatio Rational Window    -- ^ Set the aspect ratio for the window
      | ResetRatio Window           -- ^ Remove the aspect ratio for the window
      | ToggleRatio Rational Window -- ^ Toggle the reatio
      deriving Typeable

    instance Message ManageAspectRatio