DynamicProjects: allow case-insensitive prompts

Provide a way to use case-insensitive directory completion.

XMonad/Actions/DynamicProjects.hs

@@ -29,9 +29,13 @@ module XMonad.Actions.DynamicProjects
 
          -- * Bindings
        , switchProjectPrompt
+       , switchProjectPrompt'
        , shiftToProjectPrompt
+       , shiftToProjectPrompt'
        , renameProjectPrompt
+       , renameProjectPrompt'
        , changeProjectDirPrompt
+       , changeProjectDirPrompt'
 
          -- * Helper Functions
        , switchProject
@@ -145,24 +149,24 @@ instance ExtensionClass ProjectState where
 
 --------------------------------------------------------------------------------
 -- Internal types for working with XPrompt.
-data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
+data ProjectPrompt = ProjectPrompt XPConfig ComplCaseSensitivity ProjectMode [ProjectName]
 data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
 
 instance XPrompt ProjectPrompt where
-  showXPrompt (ProjectPrompt _ submode _) =
+  showXPrompt (ProjectPrompt _ _ submode _) =
     case submode of
       SwitchMode -> "Switch or Create Project: "
       ShiftMode  -> "Send Window to Project: "
       RenameMode -> "New Project Name: "
       DirMode    -> "Change Project Directory: "
 
-  completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])
+  completionFunction (ProjectPrompt _ _ RenameMode _) = return . (:[])
-  completionFunction (ProjectPrompt _ DirMode _) =
+  completionFunction (ProjectPrompt _ csn DirMode _) =
-    let xpt = directoryMultipleModes "" (const $ return ())
+    let xpt = directoryMultipleModes' csn "" (const $ return ())
     in completionFunction xpt
-  completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns
+  completionFunction (ProjectPrompt c _ _ ns) = mkComplFunFromList' c ns
 
-  modeAction (ProjectPrompt _ SwitchMode _) buf auto = do
+  modeAction (ProjectPrompt _ _ SwitchMode _) buf auto = do
     let name = if null auto then buf else auto
     ps <- XS.gets projects
 
@@ -171,17 +175,17 @@ instance XPrompt ProjectPrompt where
       Nothing | null name -> return ()
               | otherwise -> switchProject (defProject name)
 
-  modeAction (ProjectPrompt _ ShiftMode _) buf auto = do
+  modeAction (ProjectPrompt _ _ ShiftMode _) buf auto = do
     let name = if null auto then buf else auto
     ps <- XS.gets projects
     shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
 
-  modeAction (ProjectPrompt _ RenameMode _) name _ =
+  modeAction (ProjectPrompt _ _ RenameMode _) name _ =
     when (not (null name) && not (all isSpace name)) $ do
       renameWorkspaceByName name
       modifyProject (\p -> p { projectName = name })
 
-  modeAction (ProjectPrompt _ DirMode _) buf auto = do
+  modeAction (ProjectPrompt _ _ DirMode _) buf auto = do
     let dir' = if null auto then buf else auto
     dir <- io $ makeAbsolute dir'
     modifyProject (\p -> p { projectDirectory = dir })
@@ -279,7 +283,12 @@ switchProject p = do
 -- | 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 = projectPrompt [ SwitchMode
+switchProjectPrompt = switchProjectPrompt' (ComplCaseSensitive True)
+
+-- | Like @switchProjectPrompt@ with a parameter controlling
+-- completion case-sensitivity.
+switchProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
+switchProjectPrompt' csn = projectPrompt csn [ SwitchMode
                                              , ShiftMode
                                              , RenameMode
                                              , DirMode
@@ -296,7 +305,12 @@ shiftToProject p = do
 -- | Prompts for a project name and then shifts the currently focused
 -- window to that project.
 shiftToProjectPrompt :: XPConfig -> X ()
-shiftToProjectPrompt = projectPrompt [ ShiftMode
+shiftToProjectPrompt = shiftToProjectPrompt' (ComplCaseSensitive True)
+
+-- | Like @shiftToProjectPrompt@ with a parameter controlling
+-- completion case-sensitivity.
+shiftToProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
+shiftToProjectPrompt' csn = projectPrompt csn [ ShiftMode
                                               , RenameMode
                                               , SwitchMode
                                               , DirMode
@@ -305,7 +319,12 @@ shiftToProjectPrompt = projectPrompt [ ShiftMode
 --------------------------------------------------------------------------------
 -- | Rename the current project.
 renameProjectPrompt :: XPConfig -> X ()
-renameProjectPrompt = projectPrompt [ RenameMode
+renameProjectPrompt = renameProjectPrompt' (ComplCaseSensitive True)
+
+-- | Like @renameProjectPrompt@ with a parameter controlling
+-- completion case-sensitivity.
+renameProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
+renameProjectPrompt' csn = projectPrompt csn [ RenameMode
                                              , DirMode
                                              , SwitchMode
                                              , ShiftMode
@@ -317,7 +336,12 @@ renameProjectPrompt = projectPrompt [ RenameMode
 -- NOTE: This will only affect new processed started in this project.
 -- Existing processes will maintain the previous working directory.
 changeProjectDirPrompt :: XPConfig -> X ()
-changeProjectDirPrompt = projectPrompt [ DirMode
+changeProjectDirPrompt = changeProjectDirPrompt' (ComplCaseSensitive True)
+
+-- | Like @changeProjectDirPrompt@ with a parameter controlling
+-- completion case-sensitivity.
+changeProjectDirPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
+changeProjectDirPrompt' csn = projectPrompt csn [ DirMode
                                                 , SwitchMode
                                                 , ShiftMode
                                                 , RenameMode
@@ -325,13 +349,13 @@ changeProjectDirPrompt = projectPrompt [ DirMode
 
 --------------------------------------------------------------------------------
 -- | Prompt for a project name.
-projectPrompt :: [ProjectMode] -> XPConfig -> X ()
+projectPrompt :: ComplCaseSensitivity -> [ProjectMode] -> XPConfig -> X ()
-projectPrompt submodes c = do
+projectPrompt csn submodes c = do
   ws <- map W.tag <$> gets (W.workspaces . windowset)
   ps <- XS.gets projects
 
   let names = sort (Map.keys ps `union` ws)
-      modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
+      modes = map (\m -> XPT $ ProjectPrompt c csn m names) submodes
 
   mkXPromptWithModes modes c