    {-# LANGUAGE DeriveDataTypeable #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.TopicSpace
    -- Copyright   :  (c) Nicolas Pouillard
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  Nicolas Pouillard <nicolas.pouillard@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Turns your workspaces into a more topic oriented system.
    -----------------------------------------------------------------------------

    module XMonad.Actions.TopicSpace
      (
      -- * Overview
      -- $overview

      -- * Usage
      -- $usage
       Topic
      , Dir
      , TopicConfig(..)
      , defaultTopicConfig
      , getLastFocusedTopics
      , setLastFocusedTopic
      , reverseLastFocusedTopics
      , pprWindowSet
      , topicActionWithPrompt
      , topicAction
      , currentTopicAction
      , switchTopic
      , switchNthLastFocused
      , shiftNthLastFocused
      , currentTopicDir
      , checkTopicConfig
      , (>*>)
      )
    where

    import XMonad

    import Data.List
    import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
    import Data.Ord
    import qualified Data.Map as M
    import Control.Monad (liftM2,when,unless,replicateM_)
    import System.IO

    import qualified XMonad.StackSet as W

    import XMonad.Prompt
    import XMonad.Prompt.Workspace

    import XMonad.Hooks.UrgencyHook
    import XMonad.Hooks.DynamicLog (PP(..))
    import qualified XMonad.Hooks.DynamicLog as DL

    import XMonad.Util.Run (spawnPipe)
    import qualified XMonad.Util.ExtensibleState as XS

    -- $overview
    -- This module allows to organize your workspaces on a precise topic basis.  So
    -- instead of having a workspace called `work' you can setup one workspace per
    -- task.  Here we call these workspaces, topics. The great thing with
    -- topics is that one can attach a directory that makes sense to each
    -- particular topic.  One can also attach an action which will be triggered
    -- when switching to a topic that does not have any windows in it.  So you can
    -- attach your mail client to the mail topic, some terminals in the right
    -- directory to the xmonad topic... This package also provides a nice way to
    -- display your topics in an historical way using a custom `pprWindowSet'
    -- function. You can also easily switch to recent topics using this history
    -- of last focused topics.

    -- $usage
    -- Here is an example of configuration using TopicSpace:
    --
    -- > -- The list of all topics/workspaces of your xmonad configuration.
    -- > -- The order is important, new topics must be inserted
    -- > -- at the end of the list if you want hot-restarting
    -- > -- to work.
    -- > myTopics :: [Topic]
    -- > myTopics =
    -- >   [ "dashboard" -- the first one
    -- >   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
    -- >   , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
    -- >   , "yi", "documents", "twitter", "pdf"
    -- >   ]
    -- >
    -- > myTopicConfig :: TopicConfig
    -- > myTopicConfig = defaultTopicConfig
    -- >   { topicDirs = M.fromList $
    -- >       [ ("conf", "w/conf")
    -- >       , ("dashboard", "Desktop")
    -- >       , ("yi", "w/dev-haskell/yi")
    -- >       , ("darcs", "w/dev-haskell/darcs")
    -- >       , ("haskell", "w/dev-haskell")
    -- >       , ("xmonad", "w/dev-haskell/xmonad")
    -- >       , ("tools", "w/tools")
    -- >       , ("movie", "Movies")
    -- >       , ("talk", "w/talks")
    -- >       , ("music", "Music")
    -- >       , ("documents", "w/documents")
    -- >       , ("pdf", "w/documents")
    -- >       ]
    -- >   , defaultTopicAction = const $ spawnShell >*> 3
    -- >   , defaultTopic = "dashboard"
    -- >   , topicActions = M.fromList $
    -- >       [ ("conf",       spawnShell >> spawnShellIn "wd/ertai/private")
    -- >       , ("darcs",      spawnShell >*> 3)
    -- >       , ("yi",         spawnShell >*> 3)
    -- >       , ("haskell",    spawnShell >*> 2 >>
    -- >                        spawnShellIn "wd/dev-haskell/ghc")
    -- >       , ("xmonad",     spawnShellIn "wd/x11-wm/xmonad" >>
    -- >                        spawnShellIn "wd/x11-wm/xmonad/contrib" >>
    -- >                        spawnShellIn "wd/x11-wm/xmonad/utils" >>
    -- >                        spawnShellIn ".xmonad" >>
    -- >                        spawnShellIn ".xmonad")
    -- >       , ("mail",       mailAction)
    -- >       , ("irc",        ssh somewhere)
    -- >       , ("admin",      ssh somewhere >>
    -- >                        ssh nowhere)
    -- >       , ("dashboard",  spawnShell)
    -- >       , ("twitter",    spawnShell)
    -- >       , ("web",        spawn browserCmd)
    -- >       , ("movie",      spawnShell)
    -- >       , ("documents",  spawnShell >*> 2 >>
    -- >                        spawnShellIn "Documents" >*> 2)
    -- >       , ("pdf",        spawn pdfViewerCmd)
    -- >       ]
    -- >   }
    -- >
    -- > -- extend your keybindings
    -- > myKeys conf@XConfig{modMask=modm} =
    -- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
    -- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
    -- >   , ((modm              , xK_g     ), promptedGoto)
    -- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)
    -- >   {- more  keys ... -}
    -- >   ]
    -- >   ++
    -- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)
    -- >   | (i, k) <- zip [1..] workspaceKeys]
    -- >
    -- > spawnShell :: X ()
    -- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
    -- >
    -- > spawnShellIn :: Dir -> X ()
    -- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
    -- >
    -- > goto :: Topic -> X ()
    -- > goto = switchTopic myTopicConfig
    -- >
    -- > promptedGoto :: X ()
    -- > promptedGoto = workspacePrompt myXPConfig goto
    -- >
    -- > promptedShift :: X ()
    -- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
    -- >
    -- > myConfig = do
    -- >     checkTopicConfig myTopics myTopicConfig
    -- >     myLogHook <- makeMyLogHook
    -- >     return $ defaultConfig
    -- >          { borderWidth = 1 -- Width of the window border in pixels.
    -- >          , workspaces = myTopics
    -- >          , layoutHook = myModifiers myLayout
    -- >          , manageHook = myManageHook
    -- >          , logHook = myLogHook
    -- >          , handleEventHook = myHandleEventHook
    -- >          , terminal = myTerminal -- The preferred terminal program.
    -- >          , normalBorderColor = "#3f3c6d"
    -- >          , focusedBorderColor = "#4f66ff"
    -- >          , XMonad.modMask = mod1Mask
    -- >          , keys = myKeys
    -- >          , mouseBindings = myMouseBindings
    -- >          }
    -- >
    -- > main :: IO ()
    -- > main = xmonad =<< myConfig

    -- | An alias for @flip replicateM_@
    (>*>) :: Monad m => m a -> Int -> m ()
    (>*>) = flip replicateM_
    infix >*>

    -- | 'Topic' is just an alias for 'WorkspaceId'
    type Topic = WorkspaceId

    -- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
    type Dir = FilePath

    -- | Here is the topic space configuration area.
    data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
                                     -- ^ This mapping associate a directory to each topic.
                                   , topicActions       :: M.Map Topic (X ())
                                     -- ^ This mapping associate an action to trigger when
                                     -- switching to a given topic which workspace is empty.
                                   , defaultTopicAction :: Topic -> X ()
                                     -- ^ This is the default topic action.
                                   , defaultTopic       :: Topic
                                     -- ^ This is the default topic.
                                   , maxTopicHistory    :: Int
                                     -- ^ This setups the maximum depth of topic history, usually
                                     -- 10 is a good default since we can bind all of them using
                                     -- numeric keypad.
                                   }

    defaultTopicConfig :: TopicConfig
    defaultTopicConfig = TopicConfig { topicDirs = M.empty
                                     , topicActions = M.empty
                                     , defaultTopicAction = const (ask >>= spawn . terminal . config)
                                     , defaultTopic = "1"
                                     , maxTopicHistory = 10
                                     }

    newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
    instance ExtensionClass PrevTopics where
        initialValue = PrevTopics []
        extensionType = PersistentExtension

    -- | Returns the list of last focused workspaces the empty list otherwise.
    getLastFocusedTopics :: X [String]
    getLastFocusedTopics = XS.gets getPrevTopics

    -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
    -- select topics that one want to keep, this function will set the property
    -- of last focused topics.
    setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
    setLastFocusedTopic w predicate =
      XS.modify $ PrevTopics
        . seqList . nub . (w:) . filter predicate
        . getPrevTopics
      where seqList xs = length xs `seq` xs

    -- | Reverse the list of "last focused topics"
    reverseLastFocusedTopics :: X ()
    reverseLastFocusedTopics =
      XS.modify $ PrevTopics . reverse . getPrevTopics

    -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
    -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
    -- and highlighting topics with urgent windows.
    pprWindowSet :: TopicConfig -> PP -> X String
    pprWindowSet 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)
                            (`notElem` empty_workspaces)
        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 }
            sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
        return $ DL.pprWindowSet sortWindows urgents pp' winset

    -- | Given a prompt configuration and a topic configuration, triggers the action associated with
    -- the topic given in prompt.
    topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
    topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))

    -- | Given a configuration and a topic, triggers the action associated with the given topic.
    topicAction :: TopicConfig -> Topic -> X ()
    topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg

    -- | Trigger the action associated with the current topic.
    currentTopicAction :: TopicConfig -> X ()
    currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset)

    -- | Switch to the given topic.
    switchTopic :: TopicConfig -> Topic -> X ()
    switchTopic tg topic = do
      windows $ W.greedyView topic
      wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
      when (null wins) $ topicAction tg topic

    -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
    switchNthLastFocused :: TopicConfig -> Int -> X ()
    switchNthLastFocused tg depth = do
      lastWs <- getLastFocusedTopics
      switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth

    -- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
    shiftNthLastFocused :: Int -> X ()
    shiftNthLastFocused n = do
      ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
      whenJust ws $ windows . W.shift

    -- | Returns the directory associated with current topic returns the empty string otherwise.
    currentTopicDir :: TopicConfig -> X String
    currentTopicDir tg = do
      topic <- gets (W.tag . W.workspace . W.current . windowset)
      return . fromMaybe "" . M.lookup topic $ topicDirs tg

    -- | Check the given topic configuration for duplicates topics or undefined topics.
    checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
    checkTopicConfig tags tg = do
        -- tags <- gets $ map W.tag . workspaces . windowset

        let
          seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
          dups       = tags \\ nub tags
          diffTopic  = seenTopics \\ sort tags
          check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst

        check diffTopic "Seen but missing topics/workspaces"
        check dups      "Duplicate topics/workspaces"

    -- | Display the given message using the @xmessage@ program.
    xmessage :: String -> IO ()
    xmessage s = do
      h <- spawnPipe "xmessage -file -"
      hPutStr h s
      hClose h