{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.SimplestFloat
-- Description :  Like "XMonad.Layout.SimpleFloat" but without the decoration.
-- Copyright   :  (c) 2008 Jussi Mäki
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  joamaki@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A basic floating layout like SimpleFloat but without the decoration.
-----------------------------------------------------------------------------

module XMonad.Layout.SimplestFloat
    ( -- * Usage:
      -- $usage
      simplestFloat
    , SimplestFloat
    ) where

import XMonad.Prelude (fi)
import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.WindowArranger
import XMonad.Layout.LayoutModifier

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.SimplestFloat
--
-- Then edit your @layoutHook@ by adding the SimplestFloat layout:
--
-- > myLayout = simplestFloat ||| Full ||| etc..
-- > main = xmonad def { layoutHook = 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 simple floating layout where every window is placed according
-- to the window's initial attributes.
simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a
simplestFloat :: forall a. Eq a => ModifiedLayout WindowArranger SimplestFloat a
simplestFloat = forall (l :: * -> *) a. l a -> ModifiedLayout WindowArranger l a
windowArrangeAll forall a. SimplestFloat a
SF

data SimplestFloat a = SF deriving (Int -> SimplestFloat a -> ShowS
forall a. Int -> SimplestFloat a -> ShowS
forall a. [SimplestFloat a] -> ShowS
forall a. SimplestFloat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimplestFloat a] -> ShowS
$cshowList :: forall a. [SimplestFloat a] -> ShowS
show :: SimplestFloat a -> String
$cshow :: forall a. SimplestFloat a -> String
showsPrec :: Int -> SimplestFloat a -> ShowS
$cshowsPrec :: forall a. Int -> SimplestFloat a -> ShowS
Show, ReadPrec [SimplestFloat a]
ReadPrec (SimplestFloat a)
ReadS [SimplestFloat a]
forall a. ReadPrec [SimplestFloat a]
forall a. ReadPrec (SimplestFloat a)
forall a. Int -> ReadS (SimplestFloat a)
forall a. ReadS [SimplestFloat a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SimplestFloat a]
$creadListPrec :: forall a. ReadPrec [SimplestFloat a]
readPrec :: ReadPrec (SimplestFloat a)
$creadPrec :: forall a. ReadPrec (SimplestFloat a)
readList :: ReadS [SimplestFloat a]
$creadList :: forall a. ReadS [SimplestFloat a]
readsPrec :: Int -> ReadS (SimplestFloat a)
$creadsPrec :: forall a. Int -> ReadS (SimplestFloat a)
Read)
instance LayoutClass SimplestFloat Window where
    doLayout :: SimplestFloat Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (SimplestFloat Window))
doLayout SimplestFloat Window
SF Rectangle
sc (S.Stack Window
w [Window]
l [Window]
r) =  (, forall a. Maybe a
Nothing)
                                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rectangle -> Window -> X (Window, Rectangle)
getSize Rectangle
sc) (Window
w forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [Window]
l forall a. [a] -> [a] -> [a]
++ [Window]
r)
    description :: SimplestFloat Window -> String
description SimplestFloat Window
_ = String
"SimplestFloat"

getSize :: Rectangle -> Window -> X (Window,Rectangle)
getSize :: Rectangle -> Window -> X (Window, Rectangle)
getSize (Rectangle Position
rx Position
ry Dimension
_ Dimension
_) Window
w = do
  Display
d  <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Dimension
bw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> Dimension
borderWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
  WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
  let x :: Position
x  =  forall a. Ord a => a -> a -> a
max Position
rx forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa
      y :: Position
y  =  forall a. Ord a => a -> a -> a
max Position
ry forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa
      wh :: Dimension
wh = forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_width  WindowAttributes
wa) forall a. Num a => a -> a -> a
+ (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2)
      ht :: Dimension
ht = forall a b. (Integral a, Num b) => a -> b
fi (WindowAttributes -> CInt
wa_height WindowAttributes
wa) forall a. Num a => a -> a -> a
+ (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Window
w, Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
wh Dimension
ht)