-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Directory
-- Description :  A directory prompt for XMonad.
-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy
-- License     :  BSD3
--
-- Maintainer  :
-- Stability   :  unstable
-- Portability :  unportable
--
-- A directory prompt for XMonad
--
-----------------------------------------------------------------------------

module XMonad.Prompt.Directory (
                             -- * Usage
                             -- $usage
                             directoryPrompt,
                             directoryMultipleModes,
                             directoryMultipleModes',
                             Dir
                              ) where

import XMonad.Prelude ( sort )

import XMonad
import XMonad.Prompt
import XMonad.Prompt.Shell ( compgenDirectories )

-- $usage
-- For an example usage see "XMonad.Layout.WorkspaceDir"

data Dir = Dir String ComplCaseSensitivity (String -> X ())

instance XPrompt Dir where
    showXPrompt :: Dir -> String
showXPrompt (Dir String
x ComplCaseSensitivity
_ String -> X ()
_) = String
x
    completionFunction :: Dir -> ComplFunction
completionFunction (Dir String
_ ComplCaseSensitivity
csn String -> X ()
_) = ComplCaseSensitivity -> ComplFunction
getDirCompl ComplCaseSensitivity
csn
    modeAction :: Dir -> String -> String -> X ()
modeAction (Dir String
_ ComplCaseSensitivity
_ String -> X ()
f) String
buf String
auto =
      let dir :: String
dir = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
auto then String
buf else String
auto
      in String -> X ()
f String
dir

directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
directoryPrompt XPConfig
c String
prom String -> X ()
f = Dir -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> ComplCaseSensitivity -> (String -> X ()) -> Dir
Dir String
prom ComplCaseSensitivity
csn String -> X ()
f) XPConfig
c (ComplCaseSensitivity -> ComplFunction
getDirCompl ComplCaseSensitivity
csn) String -> X ()
f
    where csn :: ComplCaseSensitivity
csn = XPConfig -> ComplCaseSensitivity
complCaseSensitivity XPConfig
c

-- | A @XPType@ entry suitable for using with @mkXPromptWithModes@.
directoryMultipleModes :: String            -- ^ Prompt.
                       -> (String -> X ())  -- ^ Action.
                       -> XPType
directoryMultipleModes :: String -> (String -> X ()) -> XPType
directoryMultipleModes = ComplCaseSensitivity -> String -> (String -> X ()) -> XPType
directoryMultipleModes' ComplCaseSensitivity
CaseSensitive

-- | Like @directoryMultipleModes@ with a parameter for completion case-sensitivity.
directoryMultipleModes' :: ComplCaseSensitivity -- ^ Completion case sensitivity.
                        -> String               -- ^ Prompt.
                        -> (String -> X ())     -- ^ Action.
                        -> XPType
directoryMultipleModes' :: ComplCaseSensitivity -> String -> (String -> X ()) -> XPType
directoryMultipleModes' ComplCaseSensitivity
csn String
p String -> X ()
f = Dir -> XPType
forall p. XPrompt p => p -> XPType
XPT (String -> ComplCaseSensitivity -> (String -> X ()) -> Dir
Dir String
p ComplCaseSensitivity
csn String -> X ()
f)

getDirCompl :: ComplCaseSensitivity -> String -> IO [String]
getDirCompl :: ComplCaseSensitivity -> ComplFunction
getDirCompl ComplCaseSensitivity
csn String
s = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
notboring ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComplCaseSensitivity -> String -> IO String
compgenDirectories ComplCaseSensitivity
csn String
s

notboring :: String -> Bool
notboring :: String -> Bool
notboring (Char
'.':Char
'.':String
_) = Bool
True
notboring (Char
'.':String
_) = Bool
False
notboring String
_ = Bool
True