[Xmonad] darcs patch: ShellPrompt.hs: a quick optimization of nub

[Andrea Rossato]

On Mon, Oct 15, 2007 at 07:54:28PM -0400, gwern0 at gmail.com wrote:

> Mon Oct 15 19:48:50 EDT 2007  gwern0 at gmail.com
>   * ShellPrompt.hs: a quick optimization of nub
>   I saw some complaints about ShellPrompt being slow - and noticed
>   it myself - and it seems ShellPrompt uses 'nub' in an awkward
>   place to uniquefy input. Nub doesn't perform well on long lists,
>   but I once ran into a similar problem and the suggested solution
>   was something clever: convert to a Set and then back to a List.
>   Sets can't have duplicate entries, and they uniquefy faster than
>   nub. The price is that the output is not sorted the same as nub's
>   output would be, but this is OK because the output of (toList .
>   fromList) is immediately passed to 'sort' - which should then
>   produce the same output for both versions. I haven't really tested
>   this but on long directories this should help.


Indeed the benchmarks I tried show that the problem was nub. Quite
amazingly changing nub with toList . fromList means reducing cpu time
of about 75%.

With numb:
time promptReadline /usr/bin/
2878
real	0m8.504s
user	0m7.559s
sys	0m0.019s

time promptGetDirCont /usr/bin/
2878
real	0m8.429s
user	0m7.554s
sys	0m0.039s


With toList . fromList:
time promptReadlineSet /usr/bin/
2878
real	0m0.110s
user	0m0.082s
sys	0m0.004s


time promptGetDirContSet /usr/bin/
2878
real	0m0.227s
user	0m0.185s
sys	0m0.022s

It is true that ReadLine is twice quicker that getDirectoryContent but
I would prefer not to rely on an external library for such an
improvement. What do you think?

Andrea
-------------- next part --------------
import Control.Monad
import Data.List
import System.Console.Readline
import System.Environment

getShellCompl :: String -> IO [String]
getShellCompl s 
    | s /= "" && last s /= ' ' = do
  fl <- filenameCompletionFunction s
  c <- commandCompletionFunction s
  return $ sort . nub $ fl ++ c
    | otherwise = return []

commandCompletionFunction :: String -> IO [String]
commandCompletionFunction str 
    | '/' `elem` str = return []
    | otherwise = do
  p <- getEnv "PATH"
  cl p
    where
      cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':'  
      addToPath = flip (++) ("/" ++ str)
      fCF = filenameCompletionFunction

rmPath :: [String] -> [String]
rmPath s = 
    map (reverse . fst . break  (=='/') . reverse) s

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split e l =
    f : split e (rest ls)
        where 
          (f,ls) = span (/=e) l
          rest s | s == [] = []
                 | otherwise = tail s


main = do
  a <- getArgs
  putStrLn =<< fmap (show . length) (getShellCompl $ a !! 0)
-------------- next part --------------
import Control.Monad
import Data.List
import System.Console.Readline
import System.Environment
import qualified Data.Set as S

getShellCompl :: String -> IO [String]
getShellCompl s 
    | s /= "" && last s /= ' ' = do
  fl <- filenameCompletionFunction s
  c <- commandCompletionFunction s
  return $ sort . (S.toList . S.fromList) $ fl ++ c
    | otherwise = return []

commandCompletionFunction :: String -> IO [String]
commandCompletionFunction str 
    | '/' `elem` str = return []
    | otherwise = do
  p <- getEnv "PATH"
  cl p
    where
      cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':'  
      addToPath = flip (++) ("/" ++ str)
      fCF = filenameCompletionFunction

rmPath :: [String] -> [String]
rmPath s = 
    map (reverse . fst . break  (=='/') . reverse) s

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split e l =
    f : split e (rest ls)
        where 
          (f,ls) = span (/=e) l
          rest s | s == [] = []
                 | otherwise = tail s


main = do
  a <- getArgs
  putStrLn =<< fmap (show . length) (getShellCompl $ a !! 0)
-------------- next part --------------
import Control.Monad
import Data.List
import System.Directory
import System.IO
import System.Environment
import System.Process


runProcessWithInput :: FilePath -> [String] -> String -> IO String
runProcessWithInput cmd args input = do
    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
    hPutStr pin input
    hClose pin
    output <- hGetContents pout
    when (output==output) $ return ()
    hClose pout
    hClose perr
    waitForProcess ph
    return output

getShellCompl :: String -> IO [String]
getShellCompl s
    | s /= "" && last s /= ' ' = do
  f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
  c <- commandCompletionFunction s
  return . map escape . sort . nub $ f ++ c
    | otherwise = return []

commandCompletionFunction :: String -> IO [String]
commandCompletionFunction str
    | '/' `elem` str = return []
    | otherwise      = do
  p  <- getEnv "PATH" `catch` const (return [])
  let ds = split ':' p
      fp d f = d ++ "/" ++ f
  es <- forM ds $ \d -> do
          exists <- doesDirectoryExist d
          if exists
             then getDirectoryContents d >>= filterM (isExecutable . fp d)
             else return []
  return . filter (isPrefixOf str) . concat $ es

isExecutable :: FilePath ->IO Bool
isExecutable f = do
    fe <- doesFileExist f
    if fe
        then fmap executable $ getPermissions f
        else return False

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split e l =
    f : split e (rest ls)
        where
          (f,ls) = span (/=e) l
          rest s | s == []   = []
                 | otherwise = tail s

escape :: String -> String
escape []       = ""
escape (' ':xs) = "\\ " ++ escape xs
escape (x:xs)
    | isSpecialChar x = '\\' : x : escape xs
    | otherwise       = x : escape xs

isSpecialChar :: Char -> Bool
isSpecialChar =  flip elem "\\@\"'#?$*()[]{};"

main = do
  a <- getArgs
  putStrLn =<< fmap (show . length) (getShellCompl $ a !! 0)
-------------- next part --------------
import Control.Monad
import Data.List
import qualified Data.Set as S
import System.Directory
import System.IO
import System.Environment
import System.Process


runProcessWithInput :: FilePath -> [String] -> String -> IO String
runProcessWithInput cmd args input = do
    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
    hPutStr pin input
    hClose pin
    output <- hGetContents pout
    when (output==output) $ return ()
    hClose pout
    hClose perr
    waitForProcess ph
    return output

getShellCompl :: String -> IO [String]
getShellCompl s
    | s /= "" && last s /= ' ' = do
  f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
  c <- commandCompletionFunction s
  return . map escape . sort . (S.toList . S.fromList) $ f ++ c
    | otherwise = return []

commandCompletionFunction :: String -> IO [String]
commandCompletionFunction str
    | '/' `elem` str = return []
    | otherwise      = do
  p  <- getEnv "PATH" `catch` const (return [])
  let ds = split ':' p
      fp d f = d ++ "/" ++ f
  es <- forM ds $ \d -> do
          exists <- doesDirectoryExist d
          if exists
             then getDirectoryContents d >>= filterM (isExecutable . fp d)
             else return []
  return . filter (isPrefixOf str) . concat $ es

isExecutable :: FilePath ->IO Bool
isExecutable f = do
    fe <- doesFileExist f
    if fe
        then fmap executable $ getPermissions f
        else return False

split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split e l =
    f : split e (rest ls)
        where
          (f,ls) = span (/=e) l
          rest s | s == []   = []
                 | otherwise = tail s

escape :: String -> String
escape []       = ""
escape (' ':xs) = "\\ " ++ escape xs
escape (x:xs)
    | isSpecialChar x = '\\' : x : escape xs
    | otherwise       = x : escape xs

isSpecialChar :: Char -> Bool
isSpecialChar =  flip elem "\\@\"'#?$*()[]{};"

main = do
  a <- getArgs
  putStrLn =<< fmap (show . length) (getShellCompl $ a !! 0)