import System.IO
import System.Directory
import Data.Ratio ((%))
import Data.List
import qualified Data.Map as M

import XMonad
import XMonad.Core
import XMonad.Config
import XMonad.ManageHook
import qualified XMonad.StackSet as W
import qualified XMonad.Prompt as P

import XMonad.Layout.DecorationMadness
import XMonad.Layout.Grid
import XMonad.Layout.IM
import XMonad.Layout.MosaicAlt
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.PerWorkspace
import XMonad.Layout.Reflect
import XMonad.Layout.Tabbed
import XMonad.Layout.ThreeColumns
import XMonad.Layout.TrackFloating
import qualified XMonad.Layout.Magnifier as Mag

import XMonad.Actions.CopyWindow
import XMonad.Actions.CycleWS
import XMonad.Actions.DynamicWorkspaces
import XMonad.Actions.FindEmptyWorkspace
import XMonad.Actions.FloatSnap
import XMonad.Actions.GridSelect
import XMonad.Actions.SinkAll
import XMonad.Actions.SpawnOn
import XMonad.Actions.TopicSpace hiding (pprWindowSet)
import XMonad.Actions.UpdateFocus
import qualified XMonad.Actions.FlexibleManipulate as Flex

import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.ServerMode
import XMonad.Hooks.SetWMName
import XMonad.Hooks.UrgencyHook
import XMonad.Hooks.XPropManage

import XMonad.Prompt.AppLauncher
import XMonad.Prompt.Man
import XMonad.Prompt.Shell
import XMonad.Prompt.Ssh
import XMonad.Prompt.XMonad

import XMonad.Util.NamedScratchpad

-- taffybar
import System.Taffybar.Hooks.PagerHints (pagerHints)

-- --replace handling
import XMonad.Util.Replace (replace)
import Control.Monad (when)
import System.Environment (getArgs)

import Data.Maybe (fromMaybe, fromJust, isNothing, isJust)
import Data.Ord (comparing)

-- custom modules
import HistoryGrid
import EZConfig
import Pass

font :: String
font = "xft:Hack:size=10"

term :: String
term = "urxvt"

browser :: String
browser = "browser"


modM = mod4Mask -- mod1Mask = Alt, mod2Mask = , mod3Mask= , mod4Mask = Win, mod5Mask = AltGr

myDzenUrgencyConfig = DzenUrgencyHook
        { args = ["-bg", "red", "-fg", "black", "-fn", font,
                  "-w", "600", "-ta", "c", "-x", "520", "-y", "10",
                  "-h", "30" ]
        , duration = seconds 5
        }

--{{{ main

main = do
  args <- getArgs
  when ("--replace" `elem` args) replace

  dzenStatusDir <- getAppUserDataDirectory "xmonad"
  dzenStatusFile <- openFile (dzenStatusDir ++ "/dzenStatus") WriteMode
  xmonad
    -- Do _not_ use "ewhm" here, this would add the ewhm hooks to the
    -- end of your custom hooks (esp. the startup hook) and this would
    -- overwrite the setWMName "LG3D" and some Java apps will not work.
    $ pagerHints
    $ withUrgencyHook myDzenUrgencyConfig
    $ defaultConfig { modMask = modM
                    , terminal = term
                    , borderWidth = 1
                    , normalBorderColor  = "#545454"
                    , focusedBorderColor = "#A00000"
                    , logHook = myLogHook dzenStatusFile
                    , manageHook = myManageHook
                    , keys = \c -> mkKeymap c $ myKeys c
                    , mouseBindings = \c -> M.union (M.fromList $ myMouse c) $ mouseBindings defaultConfig c
                    , layoutHook = myLayout
                    , workspaces = topics
                    , handleEventHook = myEventHook
                    , startupHook = myStartupHook
                    }
--}}}

--{{{ TopicSpaces

topics :: [Topic]
topics = [ "web", "mail", "irc", "im", "video", "music"
         , "spline", "usdx", "partdb", "riot", "zedat"
         , "emacs", "xmonad", "gimp"]

topicsConfig = TopicConfig
  { topicDirs = M.fromList $
                [ ("web", "./")
                , ("mail", "./")
                , ("irc", "./")
                , ("im", "./")
                , ("video", "media/video")
                , ("music", "media/audio/")
                , ("spline", "dev/spline/")
                , ("usdx", "dev/usdx/")
                , ("partdb", "dev/Part-DB/")
                , ("riot", "dev/RIOT/")
                , ("zedat", "./")
                , ("emacs", "./")
                , ("xmoand", ".xmonad/")
                , ("gimp", "./")
                ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "web"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("web"    , spawnHere browser)
      , ("mail"   , spawn "emacsclient -e '(wl-start)'")
      , ("irc"    , spawnHere "hexchat")
      , ("im"     , spawnHere "tkabber")
      , ("music"  , spawnHere "guayadeque")
      , ("zedat"  , spawnHere $ term ++ " -e is")
      , ("emacs"  , spawnHere "emacs")
      , ("gimp"   , spawnHere "gimp")
      ]
  }
  where
    spawnShell = currentTopicDir topicsConfig >>= spawnShellIn
    spawnShellIn dir =
      spawnHere $ "cd " ++ dir ++ " && " ++ term

topicsGrid =
  withWindowSet $ \w -> do
    let wss = W.workspaces w
        usednames = filter (\w -> w /= "NSP") $ map W.tag $ wss
        newnames = filter (\used -> (show used `notElem` (map show topics))) usednames
    gridselect topicsGridConfig (map (\t -> (t, t)) (topics ++ newnames))

promptedGoto = topicsGrid >>= flip whenJust (switchTopic topicsConfig)

promptedShift = topicsGrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y)

--}}}

--{{{ Prompts

data MyShell = MyShell
instance XPrompt MyShell where
    showXPrompt MyShell   = "Run: "
myShellPrompt :: XPConfig -> X ()
myShellPrompt c = do
    cmds <- io getCommands
    mkXPrompt MyShell c (getShellCompl cmds) spawn

--}}}

--{{{ Scratchpads

scratchpads =
  [ NS "hotot" "hotot" (className =? "Hotot")
    (customFloating $ W.RationalRect 0.01 0.01 0.4 0.98)
  , NS "log" "urxvt -name logtail -e logtail" (appName =? "logtail")
    (customFloating $ W.RationalRect 0.03 0.03 0.94 0.6)
  ]

hiddenWS :: X (WindowSpace -> Bool)
hiddenWS = do hs <- gets (map W.tag . W.hidden . windowset)
              return (\w -> W.tag w `elem` hs)

notNspWS :: X (WindowSpace -> Bool)
notNspWS = return $ ("NSP" /=) . W.tag

notNspHiddenWS :: X (WindowSpace -> Bool)
notNspHiddenWS = do nn <- notNspWS
                    hi <- hiddenWS
                    return (\w -> hi w && nn w)

--}}}

--{{{ Themes

myPP statusFile = namedScratchpadFilterOutWorkspacePP $ defaultPP
        { ppCurrent = wrap "^fg(#FF0000) " " "
        , ppVisible = wrap "^fg(#0000FF) " " "
        , ppHiddenNoWindows = \_ -> ""
        , ppUrgent = wrap "^bg(#FFFF00)^fg(#FF0000) " " "
        , ppHidden = pad
        , ppWsSep = "^fg(#888)^bg(#000):"
        , ppSep = "^fg(#888)^bg(#000):"
        , ppLayout = wrap "^fg(#fff)" "^fg(#888)" . pad . (\x -> transformLayout x)
        , ppTitle = ("^fg(#FF0000) " ++) . dzenEscape
        , ppOrder = \(ws:l:t:[]) -> ["^fg(#888)^bg(#000)" ++ ws,l,t]
        , ppOutput = dzenWriteStatus statusFile
        }
  where
    dzenWriteStatus file status = do
      hPutStrLn file status
      hFlush file
    -- helper for better Layoutnames
    transformLayout x = foldl1 (++)
                        $ layoutTransform
                        $ magnifierTransform
                        $ [] : words x
    magnifierTransform (prefix:magnifier:status:xs)
      | magnifier == "Magnifier" && status == "(off)" = (prefix ++ "+"):xs
      | magnifier == "Magnifier" = (prefix ++ "*"):status:xs
      | otherwise =  ((prefix ++ unwords [magnifier, status]):xs)
    layoutTransform (prefix:l)
      | unwords l == "ThreeCol" = [prefix, "|||"]
      | unwords l == "Tabbed" = [prefix, "[ ]"]
      | unwords l == "Mirror Tall" = [prefix, "=|="]
      | unwords l == "Tall" = [prefix, "[]="]
      | otherwise = prefix:l

alexTheme :: Theme
alexTheme = defaultTheme
        { inactiveBorderColor = "#545454"
        , activeBorderColor = "#6E0000"
        , activeColor = "#6E0000"
        , inactiveColor = "#424242"
        , inactiveTextColor = "#ffffff"
        , activeTextColor = "#ffffff"
        , fontName = font
        , decoHeight = 19
        }

historyGridConfig = defaultGSConfig
        { gs_cellheight = 50
        , gs_cellwidth = 300
        , gs_navigate = navNSearch
        , gs_font = font
        }

topicsGridConfig = defaultGSConfig
        { gs_navigate = navNSearch
        , gs_font = font
	, gs_colorizer = colorizer
        }
  where
    colorizer topic selected
      | selected = return ("#839596", "#002b36")
      | otherwise = return ("#002b36", "#839496")

--}}}

--{{{ Hooks

myLogHook statusFile = do
  ewmhDesktopsLogHook
  topicOutput <- lastTopics topicsConfig pp
  otherOutput <- dynamicLogString pp { ppVisible = \_ -> ""
                                     , ppCurrent = \_ -> ""
				     , ppUrgent = \_ -> ""
				     , ppHidden = \_ -> ""
				     }
  io $ ppOutput pp (topicOutput ++ otherOutput)
  where
    pp = myPP statusFile
    lastTopics tg pp = do
      winset <- gets windowset
      urgents <- readUrgents
      let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
          maxDepth = maxTopicHistory tg
      setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
                          (\t -> (t `notElem` empty_workspaces && t /= "NSP"))
      lastWs <- getLastFocusedTopics
      let depth topic = fromJust $ elemIndex topic $ lastWs ++ [topic]
          add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
          pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible, ppUrgent = add_depth ppUrgent }
          sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag) . namedScratchpadFilterOutWorkspace
      return $ pprWindowSet sortWindows urgents pp' winset

myEventHook = do
  ewmhDesktopsEventHook
  serverModeEventHook
  focusOnMouseMove
  docksEventHook

myStartupHook = do
  ewmhDesktopsStartup
  adjustEventInput
  setWMName "LG3D"

myManageHook =
  namedScratchpadManageHook scratchpads
  <+> xPropManageHook xPropMatches
  <+> manageDocks
  <+> (isDialog
       --> doCenterFloat)

  <+> (appName =? "hexcalc" -->
       (doRectFloat $ W.RationalRect 0.75 0.505 0.2 0.395))
  <+> (appName =? "xcalc" -->
       (doRectFloat $ W.RationalRect 0.75 0.1 0.2 0.395))
  <+> (appName =? "wpa_gui" -->
       (doRectFloat $ W.RationalRect 0.01 0.01 0.4 0.25))
  <+> (className =? "Vncviewer" -->
       doCenterFloat)

  -- (yt) flash fullscreen mode
  <+> (className =? "Operapluginwrapper-native" -->
       doFullFloat)
  <+> (className =? "Exe" -->
       doFullFloat)

  -- xcalendar
  <+> (appName =? "dayEditor" -->
       (doRectFloat $ W.RationalRect 0.5 0.02 0.33 0.3))
  <+> (appName =? "xcalendar" -->
       (doRectFloat $ W.RationalRect 0.83 0.02 0.15 0.3))

  -- emacs compose mail
  <+> (appName =? "wanderlust-draft" -->
       (doRectFloat $ W.RationalRect 0.1 0.1 0.8 0.8))

  <+> (className =? "Gxmessage" -->
       doCenterFloat)

xPropMatches :: [XPropMatch]
xPropMatches =
  [ ([ (xprop, any (app `op`))], pmP (W.shift target)) | (xprop, op, app, target) <- myShifts] ++
  [ ([ (xprop, any (app ==))], pmX (float)) | (xprop, app) <- myFloats]
  where
    myFloats =
      [ (wM_CLASS, "vlc")
      , (wM_CLASS, "Xmessage")
      , (wM_CLASS, "XVkbd")
      , (wM_CLASS, "Xdialog")
      , (wM_CLASS, "Pinentry")
      , (wM_CLASS, "Pinentry-gtk-2")
      , (wM_CLASS, "Tiemu")
      , (wM_CLASS, "ultrastardx")
      , (wM_CLASS, "Ediff")
      , (wM_CLASS, "xtensoftphone")
      , (wM_CLASS, "Pqiv")
      , (wM_CLASS, "XNots")
      , (wM_CLASS, "TeamViewer.exe")
      , (wM_CLASS, "AmsnWebcam")
      , (wM_NAME, "glxgears")
      , (wM_NAME, "Passphrase Required")
      , (wM_NAME, "Mark all as read")
      , (wM_NAME, "Xplanet 1.2.0")
      , (wM_NAME, "Eclipse")
      ]

    myShifts =
      [ (wM_CLASS, (==), "Opera", "web")
      , (wM_CLASS, (==), "Chrome", "web")
      , (wM_CLASS, (==), "Chromium-browser", "web")
      , (wM_CLASS, (==), "Firefox-bin", "web")

      , (wM_CLASS, (==), "Claws-mail", "mail")
      , (wM_CLASS, (==), "Mitter", "mail")
      , (wM_CLASS, (==), "wanderlust", "mail")
      , (wM_NAME, (==), "newsbeuter", "mail")

      , (wM_CLASS, (==), "Hexchat", "irc")

        -- tkabber roater
      , (wM_CLASS, (==), "Tkabber", "im")
        -- tkabber single messages
      , (wM_CLASS, (==), "headlines", "im")
      , (wM_CLASS, isPrefixOf, "chat_##xmpp##1_zedatconferencejabberfuberlinde", "im")
      , (wM_CLASS, isPrefixOf, "chat_##xmpp##1_mailanimuxdeSyslogBot", "im")

      , (wM_CLASS, (==), "MPlayer", "video")
      , (wM_CLASS, (==), "Amarokapp", "music")
      ]

--}}}

--{{{ Keys

myKeys c =
  -- this line is critical to reload config - DON'T REMOVE
  [ ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" True)

  , ("M-S-<Return>", spawn term)
  , ("M-<Return>", openLastHistoryGrid historyGridConfig 30)

    -- kill current, kill all
  , ("M-S-c", kill1)
  , ("M-C-c", kill)

    -- sticky
  , ("M-S-v", windows copyToAll)
  , ("M-C-v", killAllOtherCopies)

  , ("M-<Space>", sendMessage NextLayout)
  , ("M-S-<Space>", setLayout $ XMonad.layoutHook c)

  , ("M-<Tab>", windows W.focusDown)
  , ("M-S-<Tab>", windows W.focusUp)
  , ("M-j", windows W.focusDown)
  , ("M-k", windows W.focusUp)

  , ("M-S-j", windows W.swapDown)
  , ("M-S-k", windows W.swapUp)

  , ("M-m", selectWorkspace P.defaultXPConfig)
  , ("M-S-m", withWorkspace P.defaultXPConfig (windows . W.shift))
  , ("M-S-<Backspace>", removeWorkspace)

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

    -- sink / sinkAll
  , ("M-t", withFocused $ windows . W.sink)
  , ("M-S-t", sinkAll)

  , ("M-z", namedScratchpadAction scratchpads "hotot")
  , ("M5-l", namedScratchpadAction scratchpads "log")

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

  , ("M-b", sendMessage ToggleStruts)

  , ("M-i", spawn "xprop | gxmessage -file -")

  , ("M-<Left>", moveTo Prev $ WSIs notNspHiddenWS)
  , ("M-<Right>", moveTo Next $ WSIs notNspHiddenWS)

  , ("M-d", spawn "fbsetroot -solid black")
  , ("M-f", spawn "fbsetroot -l")

  , ("M-^", focusUrgent)

  , ("M-p", myShellPrompt P.defaultXPConfig)
  , ("M-e", launchApp P.defaultXPConfig "emacsclient" >> (windows (W.greedyView "5:code")))

  , ("M-o M-k", passPrompt P.defaultXPConfig)
  , ("M-o M-S-k", passGeneratePrompt P.defaultXPConfig)
  , ("M-o M-m", manPrompt P.defaultXPConfig)
  , ("M-o M-b", safePrompt browser P.defaultXPConfig)
  , ("M-o M-s", sshPrompt P.defaultXPConfig)
  , ("M-o M-x", xmonadPrompt P.defaultXPConfig)

  , ("M-+", sendMessage Mag.MagnifyMore)
  , ("M-S-+", sendMessage Mag.MagnifyLess)
  , ("M-#", sendMessage Mag.Toggle)

    -- topics
  ,("M-s"  , promptedGoto)
  ,("M-S-s", promptedShift)

    -- multimedia keys
  , ("<XF86AudioLowerVolume>", spawn "amixer -c0 -- set Master playback 2dB-")
  , ("<XF86AudioRaiseVolume>", spawn "amixer -c0 -- set Master playback 2dB+")
  , ("<XF86AudioMute>", spawn "amixer -q -c0 set Master toggle")

    -- Screenshot
  , ("<Print>", spawn "scrot '%Y-%m-%d_%s_$wx$h.png' -e 'mv $f ~/images/screenshot/; pqiv ~/images/screenshot/$n'")

  ]
  ++
  [
    -- switch to / move to topic
    ("M-" ++ m ++ [k], a i)
      | (a, m) <- [(switchNthLastFocused topicsConfig,""), (shiftNthLastFocused, "S-")]
      , (i, k) <- zip [1..] "123456789"
  ]


myMouse c =
  [ ((modM, button1),
     (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))

  , ((modM .|. shiftMask, button1),
     (\w -> focus w >> mouseMoveWindow w >> snapMagicMouseResize 0.8 (Just 50) (Just 50) w))

  , ((modM, button3),
     (\w -> focus w >> Flex.mouseWindow Flex.resize w))
  ]

--}}}

--{{{ Layout

myLayout =
  avoidStruts
  $ smartBorders
  $ Mag.magnifierOff
  $ trackFloating

  $ onWorkspace "2:mail" layoutsTabbed
  $ onWorkspace "4:im"  (imgrid ||| imtab ||| immosaic)
  $ onWorkspace "5:code" layoutsTabbed
  $ onWorkspace "video" (noBorders myTabbed)
  $ onWorkspace "gimp" gimp
  $ layouts
  where
    layouts  = tiled ||| Mirror tiled ||| ThreeColMid 1 (3/100) (1/2) ||| myTabbed
    layoutsTabbed = myTabbed ||| tiled ||| Mirror tiled ||| ThreeColMid 1 (3/100) (1/2)
    tiled    = Tall 1 (3/100) (1/2)
    gimp     = named "gimp"
               $ withIM (0.11) (Role "gimp-toolbox")
               $ reflectHoriz
               $ withIM (0.15) (Role "gimp-dock") (trackFloating myTabbed)
    imbase a = withIM (1%7) (Or (ClassName "Tkabber") (Role "roster")) a
    imgrid   = imbase Grid
    imtab    = imbase myTabbed
    immosaic = imbase $ MosaicAlt M.empty
    myTabbed = named "Tabbed"
               $ tabbedBottom shrinkText alexTheme

--}}}