    --------------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.DynamicProjects
    -- Description :  Treat workspaces as individual project areas.
    -- Copyright   :  (c) Peter J. Jones
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Peter Jones <pjones@devalot.com>
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- Imbues workspaces with additional features so they can be treated
    -- as individual project areas.
    --------------------------------------------------------------------------------
    module XMonad.Actions.DynamicProjects
           ( -- * Overview
             -- $overview

             -- * Usage
             -- $usage

             -- * Types
             Project (..)
           , ProjectName

             -- * Hooks
           , dynamicProjects

             -- * Bindings
           , switchProjectPrompt
           , shiftToProjectPrompt
           , renameProjectPrompt
           , changeProjectDirPrompt

             -- * Helper Functions
           , switchProject
           , shiftToProject
           , lookupProject
           , currentProject
           , activateProject
           , modifyProject
           ) where

    --------------------------------------------------------------------------------
    import Data.Map.Strict (Map)
    import qualified Data.Map.Strict as Map
    import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
    import XMonad.Prelude
    import XMonad
    import XMonad.Actions.DynamicWorkspaces
    import XMonad.Prompt
    import XMonad.Prompt.Directory
    import qualified XMonad.StackSet as W
    import qualified XMonad.Util.ExtensibleState as XS

    --------------------------------------------------------------------------------
    -- $overview
    -- Inspired by @TopicSpace@, @DynamicWorkspaces@, and @WorkspaceDir@,
    -- @DynamicProjects@ treats workspaces as projects while maintaining
    -- compatibility with all existing workspace-related functionality in
    -- XMonad.
    --
    -- Instead of using generic workspace names such as @3@ or @work@,
    -- @DynamicProjects@ allows you to dedicate workspaces to specific
    -- projects and then switch between projects easily.
    --
    -- A project is made up of a name, working directory, and a start-up
    -- hook.  When you switch to a workspace, @DynamicProjects@ changes
    -- the working directory to the one configured for the matching
    -- project.  If the workspace doesn't have any windows, the project's
    -- start-up hook is executed.  This allows you to launch applications
    -- or further configure the workspace/project.
    --
    -- When using the @switchProjectPrompt@ function, workspaces are
    -- created as needed.  This means you can create new project spaces
    -- (and therefore workspaces) on the fly.  (These dynamic projects are
    -- not preserved across restarts.)
    --
    -- Additionally, frequently used projects can be configured statically
    -- in your XMonad configuration.  Doing so allows you to configure the
    -- per-project start-up hook.

    --------------------------------------------------------------------------------
    -- $usage
    -- To use @DynamicProjects@ you need to add it to your XMonad
    -- configuration and then configure some optional key bindings.
    --
    -- > import XMonad.Actions.DynamicProjects
    --
    -- Start by defining some projects:
    --
    -- > projects :: [Project]
    -- > projects =
    -- >   [ Project { projectName      = "scratch"
    -- >             , projectDirectory = "~/"
    -- >             , projectStartHook = Nothing
    -- >             }
    -- >
    -- >   , Project { projectName      = "browser"
    -- >             , projectDirectory = "~/download"
    -- >             , projectStartHook = Just $ do spawn "conkeror"
    -- >                                            spawn "chromium"
    -- >             }
    -- >   ]
    --
    -- Then inject @DynamicProjects@ into your XMonad configuration:
    --
    -- > main = xmonad $ dynamicProjects projects def
    --
    -- And finally, configure some optional key bindings:
    --
    -- >  , ((modm, xK_space), switchProjectPrompt def)
    -- >  , ((modm, xK_slash), shiftToProjectPrompt def)
    --
    -- For detailed instructions on editing your key bindings, see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

    --------------------------------------------------------------------------------
    type ProjectName  = String
    type ProjectTable = Map ProjectName Project

    --------------------------------------------------------------------------------
    -- | Details about a workspace that represents a project.
    data Project = Project
      { Project -> ProjectName
    projectName      :: !ProjectName    -- ^ Workspace name.
      , Project -> ProjectName
    projectDirectory :: !FilePath       -- ^ Working directory.
      , Project -> Maybe (X ())
    projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
      }

    --------------------------------------------------------------------------------
    -- | Internal project state.
    data ProjectState = ProjectState
      { ProjectState -> ProjectTable
    projects        :: !ProjectTable
      , ProjectState -> Maybe ProjectName
    previousProject :: !(Maybe WorkspaceId)
      }

    --------------------------------------------------------------------------------
    instance ExtensionClass ProjectState where
      initialValue :: ProjectState
    initialValue = ProjectTable -> Maybe ProjectName -> ProjectState
    ProjectState ProjectTable
    forall k a. Map k a
    Map.empty Maybe ProjectName
    forall a. Maybe a
    Nothing

    --------------------------------------------------------------------------------
    -- Internal types for working with XPrompt.
    data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
    data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode

    instance XPrompt ProjectPrompt where
      showXPrompt :: ProjectPrompt -> ProjectName
    showXPrompt (ProjectPrompt XPConfig
    _ ProjectMode
    submode [ProjectName]
    _) =
        case ProjectMode
    submode of
          ProjectMode
    SwitchMode -> ProjectName
    "Switch or Create Project: "
          ProjectMode
    ShiftMode  -> ProjectName
    "Send Window to Project: "
          ProjectMode
    RenameMode -> ProjectName
    "New Project Name: "
          ProjectMode
    DirMode    -> ProjectName
    "Change Project Directory: "

      completionFunction :: ProjectPrompt -> ComplFunction
    completionFunction (ProjectPrompt XPConfig
    _ ProjectMode
    RenameMode [ProjectName]
    _) = [ProjectName] -> IO [ProjectName]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ProjectName] -> IO [ProjectName])
    -> (ProjectName -> [ProjectName]) -> ComplFunction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProjectName -> [ProjectName] -> [ProjectName]
    forall a. a -> [a] -> [a]
    :[])
      completionFunction (ProjectPrompt XPConfig
    c ProjectMode
    DirMode [ProjectName]
    _) =
        let xpt :: XPType
    xpt = ComplCaseSensitivity
    -> ProjectName -> (ProjectName -> X ()) -> XPType
    directoryMultipleModes' (XPConfig -> ComplCaseSensitivity
    complCaseSensitivity XPConfig
    c) ProjectName
    "" (X () -> ProjectName -> X ()
    forall a b. a -> b -> a
    const (X () -> ProjectName -> X ()) -> X () -> ProjectName -> X ()
    forall a b. (a -> b) -> a -> b
    $ () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        in XPType -> ComplFunction
    forall t. XPrompt t => t -> ComplFunction
    completionFunction XPType
    xpt
      completionFunction (ProjectPrompt XPConfig
    c ProjectMode
    _ [ProjectName]
    ns) = XPConfig -> [ProjectName] -> ComplFunction
    mkComplFunFromList' XPConfig
    c [ProjectName]
    ns

      modeAction :: ProjectPrompt -> ProjectName -> ProjectName -> X ()
    modeAction (ProjectPrompt XPConfig
    _ ProjectMode
    SwitchMode [ProjectName]
    _) ProjectName
    buf ProjectName
    auto = do
        let name :: ProjectName
    name = if ProjectName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ProjectName
    auto then ProjectName
    buf else ProjectName
    auto
        ProjectTable
    ps <- (ProjectState -> ProjectTable) -> X ProjectTable
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ProjectState -> ProjectTable
    projects

        case ProjectName -> ProjectTable -> Maybe Project
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ProjectName
    name ProjectTable
    ps of
          Just Project
    p              -> Project -> X ()
    switchProject Project
    p
          Maybe Project
    Nothing | ProjectName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ProjectName
    name -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  | Bool
    otherwise -> Project -> X ()
    switchProject (ProjectName -> Project
    defProject ProjectName
    name)

      modeAction (ProjectPrompt XPConfig
    _ ProjectMode
    ShiftMode [ProjectName]
    _) ProjectName
    buf ProjectName
    auto = do
        let name :: ProjectName
    name = if ProjectName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ProjectName
    auto then ProjectName
    buf else ProjectName
    auto
        ProjectTable
    ps <- (ProjectState -> ProjectTable) -> X ProjectTable
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ProjectState -> ProjectTable
    projects
        Project -> X ()
    shiftToProject (Project -> X ())
    -> (Maybe Project -> Project) -> Maybe Project -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Project -> Maybe Project -> Project
    forall a. a -> Maybe a -> a
    fromMaybe (ProjectName -> Project
    defProject ProjectName
    name) (Maybe Project -> X ()) -> Maybe Project -> X ()
    forall a b. (a -> b) -> a -> b
    $ ProjectName -> ProjectTable -> Maybe Project
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ProjectName
    name ProjectTable
    ps

      modeAction (ProjectPrompt XPConfig
    _ ProjectMode
    RenameMode [ProjectName]
    _) ProjectName
    name ProjectName
    _ =
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (ProjectName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ProjectName
    name) Bool -> Bool -> Bool
    && Bool -> Bool
    not ((Char -> Bool) -> ProjectName -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace ProjectName
    name)) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
          ProjectName -> X ()
    renameWorkspaceByName ProjectName
    name
          (Project -> Project) -> X ()
    modifyProject (\Project
    p -> Project
    p { projectName = name })

      modeAction (ProjectPrompt XPConfig
    _ ProjectMode
    DirMode [ProjectName]
    _) ProjectName
    buf ProjectName
    auto = do
        let dir' :: ProjectName
    dir' = if ProjectName -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ProjectName
    auto then ProjectName
    buf else ProjectName
    auto
        ProjectName
    dir <- IO ProjectName -> X ProjectName
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO ProjectName -> X ProjectName)
    -> IO ProjectName -> X ProjectName
    forall a b. (a -> b) -> a -> b
    $ ProjectName -> IO ProjectName
    makeAbsolute ProjectName
    dir'
        (Project -> Project) -> X ()
    modifyProject (\Project
    p -> Project
    p { projectDirectory = dir })

    --------------------------------------------------------------------------------
    -- | Add dynamic projects support to the given config.
    dynamicProjects :: [Project] -> XConfig a -> XConfig a
    dynamicProjects :: forall (a :: * -> *). [Project] -> XConfig a -> XConfig a
    dynamicProjects [Project]
    ps XConfig a
    c =
      XConfig a
    c { startupHook     = dynamicProjectsStartupHook ps <> startupHook c
        , logHook         = dynamicProjectsLogHook        <> logHook c
        }

    --------------------------------------------------------------------------------
    -- | Log hook for tracking workspace changes.
    dynamicProjectsLogHook :: X ()
    dynamicProjectsLogHook :: X ()
    dynamicProjectsLogHook = do
      ProjectName
    name   <- (XState -> ProjectName) -> X ProjectName
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Workspace ProjectName (Layout Window) Window -> ProjectName
    forall i l a. Workspace i l a -> i
    W.tag (Workspace ProjectName (Layout Window) Window -> ProjectName)
    -> (XState -> Workspace ProjectName (Layout Window) Window)
    -> XState
    -> ProjectName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Workspace ProjectName (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Workspace ProjectName (Layout Window) Window)
    -> (XState
        -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace ProjectName (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet
             ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    windowset)
      ProjectState
    xstate <- X ProjectState
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get

      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ProjectName -> Maybe ProjectName
    forall a. a -> Maybe a
    Just ProjectName
    name Maybe ProjectName -> Maybe ProjectName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ProjectState -> Maybe ProjectName
    previousProject ProjectState
    xstate) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        ProjectState -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (ProjectState
    xstate {previousProject = Just name})
        Project -> X ()
    activateProject (Project -> X ())
    -> (Maybe Project -> Project) -> Maybe Project -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Project -> Maybe Project -> Project
    forall a. a -> Maybe a -> a
    fromMaybe (ProjectName -> Project
    defProject ProjectName
    name) (Maybe Project -> X ()) -> Maybe Project -> X ()
    forall a b. (a -> b) -> a -> b
    $
          ProjectName -> ProjectTable -> Maybe Project
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ProjectName
    name (ProjectState -> ProjectTable
    projects ProjectState
    xstate)

    --------------------------------------------------------------------------------
    -- | Start-up hook for recording configured projects.
    dynamicProjectsStartupHook :: [Project] -> X ()
    dynamicProjectsStartupHook :: [Project] -> X ()
    dynamicProjectsStartupHook [Project]
    ps = (ProjectState -> ProjectState) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ProjectState -> ProjectState
    go
      where
        go :: ProjectState -> ProjectState
        go :: ProjectState -> ProjectState
    go ProjectState
    s = ProjectState
    s {projects = update $ projects s}

        update :: ProjectTable -> ProjectTable
        update :: ProjectTable -> ProjectTable
    update = ProjectTable -> ProjectTable -> ProjectTable
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union ([(ProjectName, Project)] -> ProjectTable
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(ProjectName, Project)] -> ProjectTable)
    -> [(ProjectName, Project)] -> ProjectTable
    forall a b. (a -> b) -> a -> b
    $ (Project -> (ProjectName, Project))
    -> [Project] -> [(ProjectName, Project)]
    forall a b. (a -> b) -> [a] -> [b]
    map Project -> (ProjectName, Project)
    entry [Project]
    ps)

        entry :: Project -> (ProjectName, Project)
        entry :: Project -> (ProjectName, Project)
    entry Project
    p = (Project -> ProjectName
    projectName Project
    p, Project -> Project
    addDefaultHook Project
    p)

        -- Force the hook to be a @Just@ so that it doesn't automatically
        -- get deleted when switching away from a workspace with no
        -- windows.
        addDefaultHook :: Project -> Project
        addDefaultHook :: Project -> Project
    addDefaultHook Project
    p = Project
    p { projectStartHook = projectStartHook p <|>
                                                  Just (return ())
                             }

    --------------------------------------------------------------------------------
    -- | Find a project based on its name.
    lookupProject :: ProjectName -> X (Maybe Project)
    lookupProject :: ProjectName -> X (Maybe Project)
    lookupProject ProjectName
    name = ProjectName -> ProjectTable -> Maybe Project
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ProjectName
    name (ProjectTable -> Maybe Project)
    -> X ProjectTable -> X (Maybe Project)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ProjectState -> ProjectTable) -> X ProjectTable
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ProjectState -> ProjectTable
    projects

    --------------------------------------------------------------------------------
    -- | Fetch the current project (the one being used for the currently
    -- active workspace).
    currentProject :: X Project
    currentProject :: X Project
    currentProject = do
      ProjectName
    name <- (XState -> ProjectName) -> X ProjectName
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Workspace ProjectName (Layout Window) Window -> ProjectName
    forall i l a. Workspace i l a -> i
    W.tag (Workspace ProjectName (Layout Window) Window -> ProjectName)
    -> (XState -> Workspace ProjectName (Layout Window) Window)
    -> XState
    -> ProjectName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Workspace ProjectName (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Workspace ProjectName (Layout Window) Window)
    -> (XState
        -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace ProjectName (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet
             ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    windowset)
      Maybe Project
    proj <- ProjectName -> X (Maybe Project)
    lookupProject ProjectName
    name
      Project -> X Project
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Project -> X Project) -> Project -> X Project
    forall a b. (a -> b) -> a -> b
    $ Project -> Maybe Project -> Project
    forall a. a -> Maybe a -> a
    fromMaybe (ProjectName -> Project
    defProject ProjectName
    name) Maybe Project
    proj

    --------------------------------------------------------------------------------
    -- | Modify the current project using a pure function.
    modifyProject :: (Project -> Project) -> X ()
    modifyProject :: (Project -> Project) -> X ()
    modifyProject Project -> Project
    f = do
      Project
    p  <- X Project
    currentProject
      ProjectTable
    ps <- (ProjectState -> ProjectTable) -> X ProjectTable
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ProjectState -> ProjectTable
    projects

      -- If a project is renamed to match another project, the old project
      -- will be removed and replaced with this one.
      let new :: Project
    new = Project -> Project
    f Project
    p
          ps' :: ProjectTable
    ps' = ProjectName -> Project -> ProjectTable -> ProjectTable
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Project -> ProjectName
    projectName Project
    new) Project
    new (ProjectTable -> ProjectTable) -> ProjectTable -> ProjectTable
    forall a b. (a -> b) -> a -> b
    $ ProjectName -> ProjectTable -> ProjectTable
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete (Project -> ProjectName
    projectName Project
    p) ProjectTable
    ps

      (ProjectState -> ProjectState) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ((ProjectState -> ProjectState) -> X ())
    -> (ProjectState -> ProjectState) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \ProjectState
    s -> ProjectState
    s {projects = ps'}
      Project -> X ()
    activateProject Project
    new

    --------------------------------------------------------------------------------
    -- | Switch to the given project.
    switchProject :: Project -> X ()
    switchProject :: Project -> X ()
    switchProject Project
    p = do
      Workspace ProjectName (Layout Window) Window
    oldws <- (XState -> Workspace ProjectName (Layout Window) Window)
    -> X (Workspace ProjectName (Layout Window) Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Workspace ProjectName (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Workspace ProjectName (Layout Window) Window)
    -> (XState
        -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace ProjectName (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet
             ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    windowset)
      Project
    oldp <- X Project
    currentProject

      let name :: ProjectName
    name = Workspace ProjectName (Layout Window) Window -> ProjectName
    forall i l a. Workspace i l a -> i
    W.tag Workspace ProjectName (Layout Window) Window
    oldws
          ws :: [Window]
    ws   = Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Workspace ProjectName (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack Workspace ProjectName (Layout Window) Window
    oldws)

      -- If the project we are switching away from has no windows, and
      -- it's a dynamic project, remove it from the configuration.
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Window] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Window]
    ws Bool -> Bool -> Bool
    && Maybe (X ()) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Project -> Maybe (X ())
    projectStartHook Project
    oldp)) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        ProjectName -> X ()
    removeWorkspaceByTag ProjectName
    name -- also remove the old workspace
        (ProjectState -> ProjectState) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify (\ProjectState
    s -> ProjectState
    s {projects = Map.delete name $ projects s})

      ProjectName -> X ()
    appendWorkspace (Project -> ProjectName
    projectName Project
    p)

    --------------------------------------------------------------------------------
    -- | Prompt for a project name and then switch to it.  Automatically
    -- creates a project if a new name is returned from the prompt.
    switchProjectPrompt :: XPConfig -> X ()
    switchProjectPrompt :: XPConfig -> X ()
    switchProjectPrompt = [ProjectMode] -> XPConfig -> X ()
    projectPrompt [ ProjectMode
    SwitchMode
                                        , ProjectMode
    ShiftMode
                                        , ProjectMode
    RenameMode
                                        , ProjectMode
    DirMode
                                        ]

    --------------------------------------------------------------------------------
    -- | Shift the currently focused window to the given project.
    shiftToProject :: Project -> X ()
    shiftToProject :: Project -> X ()
    shiftToProject Project
    p = do
      ProjectName -> X ()
    addHiddenWorkspace (Project -> ProjectName
    projectName Project
    p)
      (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> StackSet
          ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> X ()
    windows (ProjectName
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.shift (ProjectName
     -> StackSet
          ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> StackSet
          ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> ProjectName
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall a b. (a -> b) -> a -> b
    $ Project -> ProjectName
    projectName Project
    p)

    --------------------------------------------------------------------------------
    -- | Prompts for a project name and then shifts the currently focused
    -- window to that project.
    shiftToProjectPrompt :: XPConfig -> X ()
    shiftToProjectPrompt :: XPConfig -> X ()
    shiftToProjectPrompt = [ProjectMode] -> XPConfig -> X ()
    projectPrompt [ ProjectMode
    ShiftMode
                                         , ProjectMode
    RenameMode
                                         , ProjectMode
    SwitchMode
                                         , ProjectMode
    DirMode
                                         ]

    --------------------------------------------------------------------------------
    -- | Rename the current project.
    renameProjectPrompt :: XPConfig -> X ()
    renameProjectPrompt :: XPConfig -> X ()
    renameProjectPrompt = [ProjectMode] -> XPConfig -> X ()
    projectPrompt [ ProjectMode
    RenameMode
                                        , ProjectMode
    DirMode
                                        , ProjectMode
    SwitchMode
                                        , ProjectMode
    ShiftMode
                                        ]

    --------------------------------------------------------------------------------
    -- | Change the working directory used for the current project.
    --
    -- NOTE: This will only affect new processed started in this project.
    -- Existing processes will maintain the previous working directory.
    changeProjectDirPrompt :: XPConfig -> X ()
    changeProjectDirPrompt :: XPConfig -> X ()
    changeProjectDirPrompt = [ProjectMode] -> XPConfig -> X ()
    projectPrompt [ ProjectMode
    DirMode
                                           , ProjectMode
    SwitchMode
                                           , ProjectMode
    ShiftMode
                                           , ProjectMode
    RenameMode
                                           ]

    --------------------------------------------------------------------------------
    -- | Prompt for a project name.
    projectPrompt :: [ProjectMode] -> XPConfig -> X ()
    projectPrompt :: [ProjectMode] -> XPConfig -> X ()
    projectPrompt [ProjectMode]
    submodes XPConfig
    c = do
      [ProjectName]
    ws <- (Workspace ProjectName (Layout Window) Window -> ProjectName)
    -> [Workspace ProjectName (Layout Window) Window] -> [ProjectName]
    forall a b. (a -> b) -> [a] -> [b]
    map Workspace ProjectName (Layout Window) Window -> ProjectName
    forall i l a. Workspace i l a -> i
    W.tag ([Workspace ProjectName (Layout Window) Window] -> [ProjectName])
    -> X [Workspace ProjectName (Layout Window) Window]
    -> X [ProjectName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (XState -> [Workspace ProjectName (Layout Window) Window])
    -> X [Workspace ProjectName (Layout Window) Window]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> [Workspace ProjectName (Layout Window) Window]
    forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
    W.workspaces (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> [Workspace ProjectName (Layout Window) Window])
    -> (XState
        -> StackSet
             ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> [Workspace ProjectName (Layout Window) Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    windowset)
      ProjectTable
    ps <- (ProjectState -> ProjectTable) -> X ProjectTable
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ProjectState -> ProjectTable
    projects

      let names :: [ProjectName]
    names = [ProjectName] -> [ProjectName]
    forall a. Ord a => [a] -> [a]
    sort (ProjectTable -> [ProjectName]
    forall k a. Map k a -> [k]
    Map.keys ProjectTable
    ps [ProjectName] -> [ProjectName] -> [ProjectName]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` [ProjectName]
    ws)
          modes :: [XPType]
    modes = (ProjectMode -> XPType) -> [ProjectMode] -> [XPType]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ProjectMode
    m -> ProjectPrompt -> XPType
    forall p. XPrompt p => p -> XPType
    XPT (ProjectPrompt -> XPType) -> ProjectPrompt -> XPType
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> ProjectMode -> [ProjectName] -> ProjectPrompt
    ProjectPrompt XPConfig
    c ProjectMode
    m [ProjectName]
    names) [ProjectMode]
    submodes

      [XPType] -> XPConfig -> X ()
    mkXPromptWithModes [XPType]
    modes XPConfig
    c

    --------------------------------------------------------------------------------
    -- | Activate a project by updating the working directory and
    -- possibly running its start-up hook.  This function is automatically
    -- invoked when the workspace changes.
    activateProject :: Project -> X ()
    activateProject :: Project -> X ()
    activateProject Project
    p = do
        [Window]
    ws   <- (XState -> [Window]) -> X [Window]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (XState -> Maybe (Stack Window)) -> XState -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace ProjectName (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace ProjectName (Layout Window) Window
     -> Maybe (Stack Window))
    -> (XState -> Workspace ProjectName (Layout Window) Window)
    -> XState
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Workspace ProjectName (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Workspace ProjectName (Layout Window) Window)
    -> (XState
        -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace ProjectName (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet ProjectName (Layout Window) Window ScreenId ScreenDetail
     -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet
             ProjectName (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen ProjectName (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         ProjectName (Layout Window) Window ScreenId ScreenDetail
    windowset)
        ProjectName
    home <- IO ProjectName -> X ProjectName
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO ProjectName
    getHomeDirectory

        -- Change to the project's directory.
        IO () -> X ()
    forall (m :: * -> *). MonadIO m => IO () -> m ()
    catchIO (ProjectName -> IO ()
    setCurrentDirectory (ProjectName -> IO ()) -> ProjectName -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ProjectName -> ProjectName -> ProjectName
    expandHome ProjectName
    home (ProjectName -> ProjectName) -> ProjectName -> ProjectName
    forall a b. (a -> b) -> a -> b
    $ Project -> ProjectName
    projectDirectory Project
    p)

        -- Possibly run the project's startup hook.
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Window] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Window]
    ws) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ X () -> Maybe (X ()) -> X ()
    forall a. a -> Maybe a -> a
    fromMaybe (() -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (Project -> Maybe (X ())
    projectStartHook Project
    p)

      where

        -- Replace an initial @~@ character with the home directory.
        expandHome :: FilePath -> FilePath -> FilePath
        expandHome :: ProjectName -> ProjectName -> ProjectName
    expandHome ProjectName
    home ProjectName
    dir = case ProjectName -> ProjectName -> Maybe ProjectName
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix ProjectName
    "~" ProjectName
    dir of
          Maybe ProjectName
    Nothing -> ProjectName
    dir
          Just ProjectName
    xs -> ProjectName
    home ProjectName -> ProjectName -> ProjectName
    forall a. [a] -> [a] -> [a]
    ++ ProjectName
    xs

    --------------------------------------------------------------------------------
    -- | Default project.
    defProject :: ProjectName -> Project
    defProject :: ProjectName -> Project
    defProject ProjectName
    name = ProjectName -> ProjectName -> Maybe (X ()) -> Project
    Project ProjectName
    name ProjectName
    "~/" Maybe (X ())
    forall a. Maybe a
    Nothing