Xmonad config

-- ghc --make xmonad.hs -lXi -i -ilib -fforce-recomp -main-is main -dynamic -v0 -o /home/svon/.xmonad/xmonad-x86_64-linux

import XMonad
import qualified XMonad.Util.Run as UR
import qualified XMonad.StackSet as SS
import qualified XMonad.Hooks.ManageDocks as HMD
import qualified XMonad.Hooks.DynamicLog as HDL

import qualified Data.Map as M

import qualified Foreign as F
import qualified Foreign.C.Types as FCT
import qualified Foreign.Marshal.Array as FMA
import qualified Foreign.Ptr as FP

screensCount :: Integer
screensCount = 2

font :: String
font = "xos4 Terminus:style=Regular:stylelang=en,en:slant=0:weight=80:width=100:pixelsize=12:spacing=110:foundr7 218-21b 232-233 237 254 258-259 25b 272 292 2bb-2bd 2c6-2c7 2d8-2d9 2db-2dd 300-308 30a-30c 329 384-38a 38c 381e40-1e47 1e6c-1e6d 1eb8-1eb9 1ebc-1ebd 1eca-1ecd 1ee4-1ee5 1ef8-1ef9 2000-2022 2026 2030 2032-2033 2039-203a 20200 2203-2206 2208-220d 2212 2219-221a 221e-221f 2227-222a 2248 2260-2261 2264-2265 2300 2302 2310 2319 2320-232bc 25c0 25c6 25ca-25cb 25cf 25d8-25d9 263a-263c 2640 2642 2660 2663 2665-2666 266a-266b 2713-2714 2717-2718 2800e|el|en|eo|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gn|gv|haw|ho|hr|hu|ia|ig|id|ie|ik|io|is|it|kaa|ki|kk|kl|kum|kv|kw|ka|smj|smn|so|sq|sr|ss|st|sv|sw|tg|tk|tl|tn|to|tr|ts|tt|tw|tyv|uk|uz|vo|vot|wa|wen|wo|xh|yap|zu|ak|an|crh|csb|fatF:decorative=False:postscriptname=Terminus:color=False:symbol=False"

_keys :: M.Map ( KeyMask, KeySym ) ( X () )
_keys = M.fromList $
    [ ( (               mod4Mask, xK_p ), spawn $ "dmenu_run -fn '" ++ font ++ "' "                     )
    , ( (               mod4Mask, xK_w ), toNextScreen (  1 ) SS.view >> adjustFocus >> adjustInputArea )
    , ( ( shiftMask .|. mod4Mask, xK_w ), toNextScreen (  1 ) SS.shift                                  )

    , ( (               mod4Mask, xK_s ), toNextScreen ( -1 ) SS.view >> adjustFocus >> adjustInputArea )
    , ( ( shiftMask .|. mod4Mask, xK_s ), toNextScreen ( -1 ) SS.shift                                  )

    ]

main :: IO ()
main = do
    xmobarHandle <- UR.spawnPipe "xmobar"

    let
        _logHook = do
            statusBarStr <- HDL.dynamicLogString def
            io $ UR.hPutStrLn xmobarHandle statusBarStr


    xmonad $ HMD.docks $ def
        { terminal           = "xterm"
        , modMask            = mod4Mask
        , normalBorderColor  = "#000000"
        , focusedBorderColor = "#999999"
        , borderWidth        = 1
        , focusFollowsMouse  = False
        , logHook            = _logHook
        , layoutHook         = HMD.avoidStruts $ layoutHook def
        , keys               = M.union _keys . keys def
        }


----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------


foreign import ccall "XIChangeProperty" xiChangeProperty
    :: Display
    -> FCT.CInt
    -> Atom
    -> Atom
    -> FCT.CInt
    -> FCT.CInt
    -> F.Ptr FCT.CUChar
    -> FCT.CInt
    -> IO ()


applyMatrix :: Display -> [ Float ] -> IO ()
applyMatrix dpy matrix =
    FMA.withArray ( FCT.CFloat <$> matrix ) fn

    where
        fn matrixPtr = do
            ctmAtom   <- internAtom dpy "Coordinate Transformation Matrix" False
            floatAtom <- internAtom dpy "FLOAT" False

            xiChangeProperty
                ( dpy                 )
                ( FCT.CInt 17         )
                ( ctmAtom             )
                ( floatAtom           )
                ( FCT.CInt 32         )
                ( FCT.CInt 0          )
                ( F.castPtr matrixPtr )
                ( FCT.CInt 9          )

adjustInputArea :: X ()
adjustInputArea = do
    xconf  <- ask
    xstate <- get

--------------------------------------------------------------------------------

    let
        currentDisplay = display xconf
        defaultScreenNumber = screenNumberOfScreen $ defaultScreenOfDisplay currentDisplay

        dh = fromIntegral $ displayHeight currentDisplay defaultScreenNumber
        dw = fromIntegral $ displayWidth  currentDisplay defaultScreenNumber

        currentScreenRect = screenRect $ SS.screenDetail $ SS.current $ windowset xstate

        sh = fromIntegral $ rect_height currentScreenRect
        sw = fromIntegral $ rect_width  currentScreenRect
        sy = fromIntegral $ rect_y      currentScreenRect
        sx = fromIntegral $ rect_x      currentScreenRect

        matrix =
            [ sw / dw,       0, sx / dw
            ,       0, sh / dh, sy / dh
            ,       0,       0,       1
            ]


--------------------------------------------------------------------------------
    io $ applyMatrix currentDisplay matrix


adjustFocus :: X ()
adjustFocus = do
    xconf  <- ask

    let
        currentDisplay = display xconf

        windowAttributesHandler window attributes =
            io $ do
                warpPointer
                    ( currentDisplay            )
                    ( 0                         )
                    ( window                    )
                    ( 0                         )
                    ( 0                         )
                    ( 0                         )
                    ( 0                         )
                    ( fromIntegral $ ww `div` 2 )
                    ( fromIntegral $ wh `div` 2 )

                flush currentDisplay
            where
                wh = wa_height attributes
                ww = wa_width  attributes

        focusedWindowHandler window =
            withWindowAttributes currentDisplay window $ windowAttributesHandler window

    withFocused focusedWindowHandler


withScreenId :: ( ScreenId -> X a ) -> X a
withScreenId f =
    withWindowSet ( f . SS.screen . SS.current  )

toNextScreen :: Integer -> ( WorkspaceId -> WindowSet -> WindowSet ) -> X ()
toNextScreen step f  = do
    mWorkspace <- withScreenId $ screenWorkspace . nextScreenId step
    whenJust mWorkspace $ windows . f
    where
        scrsCount = fromInteger screensCount
        nextScreenId :: Integer -> ScreenId -> ScreenId
        nextScreenId step csid =
            ( scrsCount + csid + fromInteger step ) `mod` scrsCount