{-# LANGUAGE RecordWildCards #-}

{-# LANGUAGE ScopedTypeVariables #-}

,fileCompleter

,fileExtCompleter

,dirCompleter

,PathCompleterOpts(..)

,defaultPathCompleterOpts

,pathCompleterWith

import Control.Exception (IOException, catch)

import Control.Monad (when, forM)

import Data.List (isPrefixOf)

import Data.Text (Text)

import qualified Data.Text as T

import Path hiding ((</>))

import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist)

import System.FilePath (takeBaseName, (</>), splitFileName, isRelative, takeExtension)

completer (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False }) <> mods

completer (pathCompleterWith defaultPathCompleterOpts { pcoAbsolute = False }) <> mods

completer (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False, pcoFileFilter = const False }) <> mods

completer (pathCompleterWith defaultPathCompleterOpts { pcoAbsolute = False, pcoFileFilter = const False }) <> mods

data PathCompleterOpts = PathCompleterOpts

{ pcoAbsolute :: Bool

, pcoRelative :: Bool

, pcoRootDir :: Maybe FilePath

, pcoFileFilter :: FilePath -> Bool

, pcoDirFilter :: FilePath -> Bool

}

defaultPathCompleterOpts :: PathCompleterOpts

defaultPathCompleterOpts = PathCompleterOpts

{ pcoAbsolute = True

, pcoRelative = True

, pcoRootDir = Nothing

, pcoFileFilter = const True

, pcoDirFilter = const True

}

fileCompleter :: Completer

fileCompleter = pathCompleterWith defaultPathCompleterOpts

fileExtCompleter :: [String] -> Completer

fileExtCompleter exts = pathCompleterWith defaultPathCompleterOpts { pcoFileFilter = (`elem` exts) . takeExtension }

dirCompleter :: Completer

dirCompleter = pathCompleterWith defaultPathCompleterOpts { pcoFileFilter = const False }

pathCompleterWith :: PathCompleterOpts -> Completer

pathCompleterWith PathCompleterOpts {..} = mkCompleter $ \inputRaw -> do

-- Unescape input, to handle single and double quotes. Note that the

-- results do not need to be re-escaped, due to some fiddly bash

-- magic.

let input = unescapeBashArg inputRaw

let (inputSearchDir0, searchPrefix) = splitFileName input

inputSearchDir = if inputSearchDir0 == "./" then "" else inputSearchDir0

msearchDir <-

case (isRelative inputSearchDir, pcoAbsolute, pcoRelative) of

(True, _, True) -> do

rootDir <- maybe getCurrentDirectory return pcoRootDir

return $ Just (rootDir </> inputSearchDir)

(False, True, _) -> return $ Just inputSearchDir

_ -> return Nothing

case msearchDir of

Nothing

| input == "" && pcoAbsolute -> return ["/"]

| otherwise -> return []

Just searchDir -> do

entries <- getDirectoryContents searchDir `catch` \(_ :: IOException) -> return []

results <- fmap catMaybes $ forM entries $ \entry ->

-- Skip . and .. unless user is typing . or ..

if entry `elem` ["..", "."] && searchPrefix `notElem` ["..", "."] then return Nothing else

if searchPrefix `isPrefixOf` entry

then do

let path = searchDir </> entry

case (pcoFileFilter path, pcoDirFilter path) of

(True, True) -> return $ Just (inputSearchDir </> entry)

(fileAllowed, dirAllowed) -> do

isDir <- doesDirectoryExist path

if (if isDir then dirAllowed else fileAllowed)

then return $ Just (inputSearchDir </> entry)

else return Nothing

else return Nothing

return results

unescapeBashArg :: String -> String

unescapeBashArg ('\'' : rest) = rest

unescapeBashArg ('\"' : rest) = go rest

where

go [] = []

go ('\\' : x : xs)

| x `elem` "$`\"\\\n" = x : xs

| otherwise = '\\' : x : go xs

go (x : xs) = x : go xs

unescapeBashArg input = go input

where

go [] = []

go ('\\' : x : xs) = x : go xs

go (x : xs) = x : go xs