--------------------------------------------------------------------------------
-- |
-- 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. To close a project,
-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",
-- such as @removeWorkspace@ or @removeWorkspaceByTag@.
--
-- 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 forall k a. Map k a
Map.empty 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]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
"" (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
    in 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProjectName
auto then ProjectName
buf else ProjectName
auto
    ProjectTable
ps <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProjectState -> ProjectTable
projects

    case 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 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProjectName
name -> 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProjectName
auto then ProjectName
buf else ProjectName
auto
    ProjectTable
ps <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProjectState -> ProjectTable
projects
    Project -> X ()
shiftToProject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (ProjectName -> Project
defProject ProjectName
name) forall a b. (a -> b) -> a -> b
$ 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
_ =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProjectName
name) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace ProjectName
name)) forall a b. (a -> b) -> a -> b
$ do
      ProjectName -> X ()
renameWorkspaceByName ProjectName
name
      (Project -> Project) -> X ()
modifyProject (\Project
p -> Project
p { projectName :: ProjectName
projectName = ProjectName
name })

  modeAction (ProjectPrompt XPConfig
_ ProjectMode
DirMode [ProjectName]
_) ProjectName
buf ProjectName
auto = do
    let dir' :: ProjectName
dir' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProjectName
auto then ProjectName
buf else ProjectName
auto
    ProjectName
dir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ ProjectName -> IO ProjectName
makeAbsolute ProjectName
dir'
    (Project -> Project) -> X ()
modifyProject (\Project
p -> Project
p { projectDirectory :: ProjectName
projectDirectory = ProjectName
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 :: X ()
startupHook     = [Project] -> X ()
dynamicProjectsStartupHook [Project]
ps forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
c
    , logHook :: X ()
logHook         = X ()
dynamicProjectsLogHook        forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
logHook XConfig a
c
    }

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

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just ProjectName
name forall a. Eq a => a -> a -> Bool
== ProjectState -> Maybe ProjectName
previousProject ProjectState
xstate) forall a b. (a -> b) -> a -> b
$ do
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (ProjectState
xstate {previousProject :: Maybe ProjectName
previousProject = forall a. a -> Maybe a
Just ProjectName
name})
    Project -> X ()
activateProject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (ProjectName -> Project
defProject ProjectName
name) forall a b. (a -> b) -> a -> b
$
      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 = 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 :: ProjectTable
projects = ProjectTable -> ProjectTable
update forall a b. (a -> b) -> a -> b
$ ProjectState -> ProjectTable
projects ProjectState
s}

    update :: ProjectTable -> ProjectTable
    update :: ProjectTable -> ProjectTable
update = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ 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 :: Maybe (X ())
projectStartHook = Project -> Maybe (X ())
projectStartHook Project
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                              forall a. a -> Maybe a
Just (forall (m :: * -> *) a. Monad m => a -> m a
return ())
                         }

--------------------------------------------------------------------------------
-- | Find a project based on its name.
lookupProject :: ProjectName -> X (Maybe Project)
lookupProject :: ProjectName -> X (Maybe Project)
lookupProject ProjectName
name = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ProjectName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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). If the workspace doesn't have a project, a
-- default project is returned, using the workspace name as the
-- project name.
currentProject :: X Project
currentProject :: X Project
currentProject = do
  ProjectName
name <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
  Maybe Project
proj <- ProjectName -> X (Maybe Project)
lookupProject ProjectName
name
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- 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' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Project -> ProjectName
projectName Project
new) Project
new forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Project -> ProjectName
projectName Project
p) ProjectTable
ps

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

--------------------------------------------------------------------------------
-- | Switch to the given project.
switchProject :: Project -> X ()
switchProject :: Project -> X ()
switchProject Project
p = 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)
  (WindowSet -> WindowSet) -> X ()
windows (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 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 <- forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
  ProjectTable
ps <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProjectState -> ProjectTable
projects

  let names :: [ProjectName]
names = forall a. Ord a => [a] -> [a]
sort (forall k a. Map k a -> [k]
Map.keys ProjectTable
ps forall a. Eq a => [a] -> [a] -> [a]
`union` [ProjectName]
ws)
      modes :: [XPType]
modes = forall a b. (a -> b) -> [a] -> [b]
map (\ProjectMode
m -> forall p. XPrompt p => p -> XPType
XPT 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   <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
    ProjectName
home <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ProjectName
getHomeDirectory

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

    -- Possibly run the project's startup hook.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
ws) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (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 forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ProjectName
"~" ProjectName
dir of
      Maybe ProjectName
Nothing -> ProjectName
dir
      Just ProjectName
xs -> ProjectName
home 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
"~/" forall a. Maybe a
Nothing