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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.WorkspaceDir
    -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  none
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- WorkspaceDir is an extension to set the current directory in a workspace.
    --
    -- Actually, it sets the current directory in a layout, since there's no way I
    -- know of to attach a behavior to a workspace.  This means that any terminals
    -- (or other programs) pulled up in that workspace (with that layout) will
    -- execute in that working directory.  Sort of handy, I think.
    --
    -- Note this extension requires the 'directory' package to be installed.
    --
    -----------------------------------------------------------------------------

    module XMonad.Layout.WorkspaceDir (
                                       -- * Usage
                                       -- $usage
                                       workspaceDir,
                                       changeDir,
                                       WorkspaceDir,
                                      ) where

    import System.Directory ( setCurrentDirectory, getCurrentDirectory )
    import Control.Monad ( when )

    import XMonad hiding ( focus )
    import XMonad.Prompt ( XPConfig )
    import XMonad.Prompt.Directory ( directoryPrompt )
    import XMonad.Layout.LayoutModifier
    import XMonad.StackSet ( tag, currentTag )

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Layout.WorkspaceDir
    --
    -- Then edit your @layoutHook@ by adding the Workspace layout modifier
    -- to some layout:
    --
    -- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2))  ||| Full ||| etc..
    -- > main = xmonad def { layoutHook = myLayout }
    --
    -- For more detailed instructions on editing the layoutHook see:
    --
    -- "XMonad.Doc.Extending#Editing_the_layout_hook"
    --
    -- WorkspaceDir provides also a prompt. To use it you need to import
    -- "XMonad.Prompt" and add something like this to your key bindings:
    --
    -- >  , ((modm .|. shiftMask, xK_x     ), changeDir def)
    --
    -- For detailed instruction on editing the key binding see:
    --
    -- "XMonad.Doc.Extending#Editing_key_bindings".

    data Chdir = Chdir String deriving ( Typeable )
    instance Message Chdir

    data WorkspaceDir a = WorkspaceDir String deriving ( ReadPrec [WorkspaceDir a]
    ReadPrec (WorkspaceDir a)
    Int -> ReadS (WorkspaceDir a)
    ReadS [WorkspaceDir a]
    (Int -> ReadS (WorkspaceDir a))
    -> ReadS [WorkspaceDir a]
    -> ReadPrec (WorkspaceDir a)
    -> ReadPrec [WorkspaceDir a]
    -> Read (WorkspaceDir a)
    forall a. ReadPrec [WorkspaceDir a]
    forall a. ReadPrec (WorkspaceDir a)
    forall a. Int -> ReadS (WorkspaceDir a)
    forall a. ReadS [WorkspaceDir a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [WorkspaceDir a]
    $creadListPrec :: forall a. ReadPrec [WorkspaceDir a]
    readPrec :: ReadPrec (WorkspaceDir a)
    $creadPrec :: forall a. ReadPrec (WorkspaceDir a)
    readList :: ReadS [WorkspaceDir a]
    $creadList :: forall a. ReadS [WorkspaceDir a]
    readsPrec :: Int -> ReadS (WorkspaceDir a)
    $creadsPrec :: forall a. Int -> ReadS (WorkspaceDir a)
    Read, Int -> WorkspaceDir a -> ShowS
    [WorkspaceDir a] -> ShowS
    WorkspaceDir a -> String
    (Int -> WorkspaceDir a -> ShowS)
    -> (WorkspaceDir a -> String)
    -> ([WorkspaceDir a] -> ShowS)
    -> Show (WorkspaceDir a)
    forall a. Int -> WorkspaceDir a -> ShowS
    forall a. [WorkspaceDir a] -> ShowS
    forall a. WorkspaceDir a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [WorkspaceDir a] -> ShowS
    $cshowList :: forall a. [WorkspaceDir a] -> ShowS
    show :: WorkspaceDir a -> String
    $cshow :: forall a. WorkspaceDir a -> String
    showsPrec :: Int -> WorkspaceDir a -> ShowS
    $cshowsPrec :: forall a. Int -> WorkspaceDir a -> ShowS
    Show )

    instance LayoutModifier WorkspaceDir Window where
        modifyLayout :: WorkspaceDir Window
    -> Workspace String (l Window) Window
    -> Rectangle
    -> X ([(Window, Rectangle)], Maybe (l Window))
    modifyLayout (WorkspaceDir d :: String
    d) w :: Workspace String (l Window) Window
    w r :: Rectangle
    r = do String
    tc <- (XState -> String) -> X String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> String
    forall i l a s sd. StackSet i l a s sd -> i
    currentTag(StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> String)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset)
                                               Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    tc String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Workspace String (l Window) Window -> String
    forall i l a. Workspace i l a -> i
    tag Workspace String (l Window) Window
    w) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> X ()
    scd String
    d
                                               Workspace String (l Window) Window
    -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l Window) Window
    w Rectangle
    r
        handleMess :: WorkspaceDir Window
    -> SomeMessage -> X (Maybe (WorkspaceDir Window))
    handleMess (WorkspaceDir _) m :: SomeMessage
    m
            | Just (Chdir wd :: String
    wd) <- SomeMessage -> Maybe Chdir
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = do String
    wd' <- String -> X String
    cleanDir String
    wd
                                                    Maybe (WorkspaceDir Window) -> X (Maybe (WorkspaceDir Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (WorkspaceDir Window) -> X (Maybe (WorkspaceDir Window)))
    -> Maybe (WorkspaceDir Window) -> X (Maybe (WorkspaceDir Window))
    forall a b. (a -> b) -> a -> b
    $ WorkspaceDir Window -> Maybe (WorkspaceDir Window)
    forall a. a -> Maybe a
    Just (WorkspaceDir Window -> Maybe (WorkspaceDir Window))
    -> WorkspaceDir Window -> Maybe (WorkspaceDir Window)
    forall a b. (a -> b) -> a -> b
    $ String -> WorkspaceDir Window
    forall a. String -> WorkspaceDir a
    WorkspaceDir String
    wd'
            | Bool
    otherwise = Maybe (WorkspaceDir Window) -> X (Maybe (WorkspaceDir Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (WorkspaceDir Window)
    forall a. Maybe a
    Nothing

    workspaceDir :: LayoutClass l a => String -> l a
                 -> ModifiedLayout WorkspaceDir l a
    workspaceDir :: String -> l a -> ModifiedLayout WorkspaceDir l a
    workspaceDir s :: String
    s = WorkspaceDir a -> l a -> ModifiedLayout WorkspaceDir l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (String -> WorkspaceDir a
    forall a. String -> WorkspaceDir a
    WorkspaceDir String
    s)

    cleanDir :: String -> X String
    cleanDir :: String -> X String
    cleanDir x :: String
    x = String -> X ()
    scd String
    x X () -> X String -> X String
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO String -> X String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO String
    getCurrentDirectory

    scd :: String -> X ()
    scd :: String -> X ()
    scd x :: String
    x = IO () -> X ()
    forall (m :: * -> *). MonadIO m => IO () -> m ()
    catchIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    setCurrentDirectory String
    x

    changeDir :: XPConfig -> X ()
    changeDir :: XPConfig -> X ()
    changeDir c :: XPConfig
    c = XPConfig -> String -> (String -> X ()) -> X ()
    directoryPrompt XPConfig
    c "Set working directory: " (Chdir -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Chdir -> X ()) -> (String -> Chdir) -> String -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Chdir
    Chdir)