diff --git a/shellac-haskeline/System/Console/Shell/Backend/Haskeline.hs b/shellac-haskeline/System/Console/Shell/Backend/Haskeline.hs index 4977647..49d20d2 100644 --- a/shellac-haskeline/System/Console/Shell/Backend/Haskeline.hs +++ b/shellac-haskeline/System/Console/Shell/Backend/Haskeline.hs @@ -9,7 +9,8 @@ import System.Console.Haskeline.IO import System.IO import Data.IORef import Control.Monad.State -import Data.Maybe(fromMaybe) +import Data.Maybe (fromMaybe) +import Data.Bool (bool) data ShellacState = ShellacState { inputState :: InputState, @@ -81,26 +82,29 @@ outputter (ErrorOutput str) = liftIO $ hPutStr stderr str wrapShellacCompleter :: String -> CompletionFunction -> Maybe (String -> IO [String]) -> CompletionFunc IO -wrapShellacCompleter breakChars f mg (left,right) = do - let (rword,rleft') = break (`elem` breakChars) left - let (left', word) = (reverse rleft', reverse rword) - result <- f (left',word,right) - completions <- case result of - Nothing -> case mg of - Nothing -> return [] - Just g -> g word - Just (str,[]) -> return [str] - Just (_,alts) -> return alts - return (rleft', map makeCompletion completions) - --- a hack to avoid adding a trailing space to completed folders. --- I could go a little further and test whether it corresponds to an --- actual file. -makeCompletion :: String -> Completion -makeCompletion "" = simpleCompletion "" -makeCompletion s = (simpleCompletion s) { - isFinished = not (last s `elem` "/\\") - } +wrapShellacCompleter breakChars f mg (left, right) = do + let (rword, rleft', quote) + | even quotes = wQuote $ break (`elem` breakChars) left + | otherwise = wQuote . (\(a, b) -> (a, safeTail b)) $ break (== '"') left + where + wQuote (a, b) = (a, b, not $ even quotes) + quotes = snd $ foldl cQuote (0, 0) left + cQuote (bSlashes, quotes) '\\' = (bSlashes + 1, quotes) + cQuote (bSlashes, quotes) '"' + | even bSlashes = (0, quotes + 1) + | otherwise = (0, quotes) + cQuote (_, quotes) _ = (0, quotes) + safeTail [] = [] + safeTail (_:xs) = xs + (left', word) = (reverse rleft', reverse rword) + (prefix, completions) <- maybe ((\cs -> (word, cs)) <$> maybe (return []) ($ word) mg) return =<< fmap (\(_, cs) -> ("", cs)) <$> f (left', word, right) + let + quote = any (any (`elem` breakChars)) completions + makeCompletion "" = simpleCompletion "" + makeCompletion s = (simpleCompletion s) + { replacement = s ++ bool "" "\"" quote + } + return (reverse prefix ++ bool "" "\"" quote ++ rleft', map makeCompletion completions) longestPrefix :: [String] -> String longestPrefix = foldl1 commonPrefix diff --git a/src/System/Console/Shell/RunShell.hs b/src/System/Console/Shell/RunShell.hs index f11735e..33272b6 100644 --- a/src/System/Console/Shell/RunShell.hs +++ b/src/System/Console/Shell/RunShell.hs @@ -217,9 +217,11 @@ shellLoop desc backend iss = loop bst = backendState iss loop st = do - flushOutput backend bst + flushOutput backend bst + + runSh st (outputString backend bst) (beforePrompt desc) >>= loop' . fst - runSh st (outputString backend bst) (beforePrompt desc) + loop' st = do setAttemptedCompletionFunction backend bst (completionFunction desc backend bst st)