{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}

import Control.Monad

import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M

import System.IO

import XMonad hiding ( (|||), doShift )
import XMonad.Prompt
import qualified XMonad.StackSet as W

import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.EwmhDesktops

import XMonad.Util.Run
import XMonad.Util.Dmenu
import XMonad.Util.Themes
import XMonad.Util.Loggers
import XMonad.Util.EZConfig
import XMonad.Util.WorkspaceCompare

import XMonad.Layout.LayoutModifier

import XMonad.Layout.Grid
import XMonad.Layout.Tabbed
import XMonad.Layout.TwoPane
import XMonad.Layout.Magnifier as Mag
import XMonad.Layout.NoBorders
import XMonad.Layout.LayoutHints
import XMonad.Layout.PerWorkspace
import XMonad.Layout.WorkspaceDir
import XMonad.Layout.MultiToggle as MT
import XMonad.Layout.LayoutCombinators
import qualified XMonad.Layout.HintedTile as H

import XMonad.Actions.Submap
import XMonad.Actions.Promote
import XMonad.Actions.CycleWS
import XMonad.Actions.CycleRecentWS
import XMonad.Actions.RotSlaves
import qualified XMonad.Actions.WindowBringer as B
import qualified XMonad.Actions.FlexibleResize as F

{- better than contrib additional functionality shits -}

-- | Pops open a dmenu with window titles. Choose one, and you will be
--   taken to the corresponding workspace, focus on selected window.
--    Compare to XMonad.Actions.WindowBringer
gotoMenu :: X ()
gotoMenu = B.windowMap >>= actionMenu (windows . W.focusWindow)
 where actionMenu action aMap = dmenuMap aMap >>= flip whenJust action

-- | Ensures that a workspace with a certain tag exists.
--   Creates it if it does not.
ensureWorkspace :: WorkspaceId -> X ()
ensureWorkspace t = do
  s <- gets windowset
  unless (W.tagMember t s) $ do
    l <- asks $ layoutHook . config
    let s' = s {W.hidden = W.Workspace t l Nothing : W.hidden s}
    modify $ \x -> x {windowset = s'}

-- | Removes empty dynamic workspaces.
removeEmptyDynWorkspaces :: [WorkspaceId] -> X ()
removeEmptyDynWorkspaces coreWorkspaces = do
  ws <- gets $ filter (not . isCoreWS) . W.hidden . windowset
  when (any (isNothing . W.stack) ws) $
    windows $ \s -> s {W.hidden = filter (\ws -> isCoreWS ws || (isJust $ W.stack ws))
                                $ (W.hidden s)}
 where isCoreWS = flip elem coreWorkspaces . W.tag

-- | Workspace shift hook that ensures the target workspace exists.
doShift :: WorkspaceId -> ManageHook
doShift t = do
  l <- liftX $ asks $ layoutHook . config
  let ensure s = if W.tagMember t s
                 then s
                 else s {W.hidden = W.Workspace t l Nothing : W.hidden s}
  doF $ W.shift t . ensure

-- | Runs an action with dmenu chosen workspace id.
withWorkspace :: (WorkspaceId -> X ()) -> X ()
withWorkspace action = do
  t <- dmenu . map W.tag . W.workspaces =<< gets windowset
  when (t /= "") $ do
    ensureWorkspace t
    action t

-- | Workspace cycling using michal's CycleRecentWS.
cycleAdjWS :: (WindowSpace -> Bool) -> WSDirection -> KeySym -> KeySym -> KeySym -> X ()
cycleAdjWS filterFn direction kMod kNext kPrev = do
  sortByIndex <- getSortByIndex
  let options w = map (flip W.view w . W.tag) $ filter filterFn $ shuffle (sortedWS w) (curTag w)

      sortWS = case direction of Next -> sortByIndex; _ -> reverse . sortByIndex

      sortedWS = sortWS . W.workspaces
      curTag = W.tag . W.workspace . W.current

      shuffle ws cTag = let (as, bs) = span ((/= cTag) . W.tag) ws in tail bs ++ as ++ [head bs]
  cycleWindowSets options [kMod] kNext kPrev

-- | Returns False for empty WindowSpaces.
nonEmptyWS :: WindowSpace -> Bool
nonEmptyWS = isJust . W.stack

{- config shits -}

myTheme = (theme wfarrTheme) { fontName            = "-*-terminus-medium-r-*-*-12-*-*-*-*-*-iso10646-*"
                             , activeColor         = "#ff0000"
                             , activeBorderColor   = "#ff0000"
                             , inactiveColor       = "#222222"
                             , inactiveBorderColor = "#222222"
                             , decoHeight          = 14 }

myXPConfig = defaultXPConfig { font              = "-*-terminus-medium-r-*-*-14-*-*-*-*-*-iso10646-*"
                             , bgColor           = "#222222"
                             , fgColor           = "#888888"
                             , fgHLight          = "#ffffff"
                             , bgHLight          = "#222222"
                             , promptBorderWidth = 0 }

myStatusBar = "dzen2 -ta l -h 18 -bg '#222222' -fg '#888888' -fn '-*-terminus-medium-r-*-*-14-*-*-*-*-*-iso10646-*'"

myPP h = defaultPP { ppOutput  = hPutStrLn h . (dzenColor "#ff0000" "" " nyu  " ++)

                   , ppCurrent = dzenColor "#ffffff" ""

                   , ppWsSep   = dzenColor "#ff0000" "" "."
                   , ppSep     = dzenColor "#ff0000" "" " | "

                   , ppTitle   = dzenColor "#bbbbbb" "" . shorten 80
                   , ppLayout  = dzenColor "#bbbbbb" "" }
  where lowercase = map toLower

myCoreWorkspaces = ["main", "web", "comm"]

data BRXTrans = MIRROR | FULL deriving (Read, Show, Eq, Typeable)

instance Transformer BRXTrans Window where
    transform MIRROR x k = k (Mirror x)
    transform FULL _ k = k (smartBorders $ noBorders Full)

myLayouts = avoidStrutsOn [U, L, R]
          $ workspaceDir "~"
          $ onWorkspaces ["vbox", "eclipse"] maximized
          $ onWorkspaces ["web", "anon"]
                (mkToggle1T FULL $ mkToggle1 MIRROR $ smartBorders tpTall)
          $ onWorkspace "video"
                (layoutHintsToCentre $ mkToggle1T FULL
                                     $ mkToggle1T MIRROR
                                     $ smartBorders tpTall)
          $ mkToggle1T FULL maximizable
  where
        maximized   = smartBorders $ noBorders Full
        maximizable = smartBorders
                    $ magnifierOff' (mkToggle1 MIRROR tall)
                          ||| magnifierOff (Grid ||| mkToggle1 MIRROR tpTall)

        tpTall  = TwoPane (1/20) (1/2)
        tall    = Tall 1 (1/20) (1/1.618)

myKeys conf = mkKeymap conf
            $ [
                ("M-<Space>"  , spawn "gmrun")

              , ("M-S-<Return>" , spawn $ terminal conf)

              , ("M-c"          , kill)

              , ("M-s"          , sendMessage $ MT.Toggle FULL)
              , ("M-S-s"        , sendMessage $ MT.Toggle MIRROR)

              , ("M-m"          , sendMessage Mag.Toggle)

              , ("M-v"          , withFocused (windows . W.sink))

              , ("M-b"          , sendMessage $ ToggleStrut D)
              , ("M-S-b"        , sendMessage $ ToggleStrut U)

              , ("M-r"          , sendMessage NextLayout)
              , ("M-S-r"        , setLayout $ layoutHook conf)

              , ("M-u"          , rotSlavesUp)
              , ("M-y"          , rotSlavesDown)

              , ("M-S-w"        , shiftTo Prev NonEmptyWS >> moveTo Prev NonEmptyWS)
              , ("M-S-f"        , shiftTo Next NonEmptyWS >> moveTo Next NonEmptyWS)

              , ("M-w"          , cycleAdjWS nonEmptyWS Prev xK_Super_L xK_w xK_f)
              , ("M-f"          , cycleAdjWS nonEmptyWS Next xK_Super_L xK_f xK_w)

              , ("M-a"          , cycleRecentWS [xK_Super_L] xK_a xK_a)

              , ("M-t"          , withWorkspace $ windows . W.greedyView)
              , ("M-S-t"        , withWorkspace $ windows . W.shift)

              , ("M-l"          , gotoMenu)
              , ("M-S-l"        , B.bringMenu)

              , ("M-<Return>"   , promote)

              , ("M-p"          , windows W.focusMaster)
              , ("M-n"          , windows W.focusDown)
              , ("M-e"          , windows W.focusUp)

              , ("M-S-n"        , windows W.swapDown)
              , ("M-S-e"        , windows W.swapUp)

              , ("M-,"          , sendMessage (IncMasterN 1))
              , ("M-."          , sendMessage (IncMasterN (-1)))

              , ("M-h"          , sendMessage Shrink)
              , ("M-i"          , sendMessage Expand)

              , ("M-d"          , changeDir myXPConfig)

              , ("M-k"          , refresh)

              , ("M-S-q"        , restart "xmonad" True)
              ]

myManageHooks = composeOne [ isKDETrayWindow                         -?> doIgnore
                           , isFullscreen                            -?> doFullFloat

                           , transience

                           , className =? "Eclipse"                  -?> doShift "eclipse"

                           , className =? "Amarokapp"                -?> doShift "music"
                           , className =? "VirtualBox"               -?> doShift "vbox"

                           , className =? "Gnome-dictionary"         -?> doCenterFloat
                           , className =? "Xmessage"                 -?> doCenterFloat

                           , className =? "MPlayer"                  -?> doFloat
                           , className =? "Gimp-2.4"                 -?> doFloat
                           , className =? "Gimp-2.6"                 -?> doFloat

                           , className =? "Gmrun"                    -?> doCenterFloat

                           , stringProperty "WM_WINDOW_ROLE" =? "osd" -?> doShift "fuck"

                           , title     =? "Buddy List"               -?> doCenterFloat
                           , title     =? "andreas.scholta - Skype™" -?> doCenterFloat

                           , resource  =? "desktop_window"           -?> doIgnore
                           , resource  =? "kdesktop"                 -?> doIgnore

                           , resource  =? "Do"                       -?> doIgnore
                           ]

main = do
  barPipe <- spawnPipe myStatusBar
  xmonad $ XConfig
                { terminal           = "gnome-terminal"
                , workspaces         = myCoreWorkspaces

                , modMask            = mod4Mask
                , numlockMask        = mod2Mask
                , keys               = myKeys

                , mouseBindings      = \ XConfig { modMask = modMask } -> M.fromList
                                     $ [ ( (modMask, button1)
                                         , \w -> focus w >> mouseMoveWindow w)
                                       , ( (modMask, button3)
                                         , \w -> focus w >> F.mouseResizeWindow w) ]

                , focusFollowsMouse  = True

                , borderWidth        = 1
                , normalBorderColor  = "#222222" --"#edeceb"
                , focusedBorderColor = "#ff0000"

                , handleEventHook    = ewmhDesktopsEventHook
                , logHook            = removeEmptyDynWorkspaces myCoreWorkspaces
                                     >> ewmhDesktopsLogHook
                                     >> dynamicLogWithPP (myPP barPipe)

                , layoutHook         = myLayouts
                , manageHook         = manageDocks <+> myManageHooks

                , startupHook        = return () }