{-# LANGUAGE CPP, NoImplicitPrelude, DoAndIfThenElse, TypeFamilies, FlexibleContexts #-}
module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where
import IHaskellPrelude
import Data.Char
import Data.List (init, last, elemIndex)
import qualified Data.List.Split as Split
import qualified Data.List.Split.Internals as Split
import System.Environment (getEnv)
import GHC hiding (ModuleName)
#if MIN_VERSION_ghc(9,4,0)
import GHC.Unit.Database
import GHC.Unit.State
import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Driver.Session
import GHC.Driver.Monad as GhcMonad
#elif MIN_VERSION_ghc(9,2,0)
import GHC.Unit.Database
import GHC.Unit.State
import GHC.Driver.Ppr
import GHC.Driver.Session
import GHC.Driver.Monad as GhcMonad
#elif MIN_VERSION_ghc(9,0,0)
import GHC.Unit.Database
import GHC.Unit.State
import GHC.Driver.Session
import GHC.Driver.Monad as GhcMonad
import GHC.Utils.Outputable (showPpr)
#else
import GHC.PackageDb
import DynFlags
import GhcMonad
import Outputable (showPpr)
#endif
import System.Directory
import Control.Exception (try)
import System.Console.Haskeline.Completion
import IHaskell.Types
import IHaskell.Eval.Evaluate (Interpreter)
import IHaskell.Eval.ParseShell (parseShell)
import StringUtils (replace, strip, split)
data CompletionType = Empty
| Identifier String
| DynFlag String
| Qualified String String
| ModuleName String String
| HsFilePath String String
| FilePath String String
| KernelOption String
| Extension String
deriving (Int -> CompletionType -> ShowS
[CompletionType] -> ShowS
CompletionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionType] -> ShowS
$cshowList :: [CompletionType] -> ShowS
show :: CompletionType -> String
$cshow :: CompletionType -> String
showsPrec :: Int -> CompletionType -> ShowS
$cshowsPrec :: Int -> CompletionType -> ShowS
Show, CompletionType -> CompletionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c== :: CompletionType -> CompletionType -> Bool
Eq)
#if MIN_VERSION_ghc(8,2,0)
exposedName :: (a, b) -> a
exposedName :: forall a b. (a, b) -> a
exposedName = forall a b. (a, b) -> a
fst
#endif
extName :: FlagSpec flag -> String
extName :: forall flag. FlagSpec flag -> String
extName (FlagSpec { flagSpecName :: forall flag. FlagSpec flag -> String
flagSpecName = String
name }) = String
name
complete :: String -> Int -> Interpreter (String, [String])
complete :: String -> Int -> Interpreter (String, [String])
complete String
code Int
posOffset = do
let findLine :: Int -> [String] -> (Int, String)
findLine Int
offset (String
first:[String]
rest) =
if Int
offset forall a. Ord a => a -> a -> Bool
<= forall (t :: * -> *) a. Foldable t => t a -> Int
length String
first
then (Int
offset, String
first)
else Int -> [String] -> (Int, String)
findLine (Int
offset forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
first forall a. Num a => a -> a -> a
- Int
1) [String]
rest
findLine Int
_ [] = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not find line: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
code, Int
posOffset)
(Int
pos, String
line) = Int -> [String] -> (Int, String)
findLine Int
posOffset (String -> [String]
lines String
code)
DynFlags
flags <- forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
[String]
rdrNames <- forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
flags) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GhcMonad m => m [RdrName]
getRdrNamesInScope
[String]
scopeNames <- forall a. Eq a => [a] -> [a]
nub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
flags) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GhcMonad m => m [Name]
getNamesInScope
let isQualified :: String -> Bool
isQualified = (Char
'.' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
unqualNames :: [String]
unqualNames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isQualified) [String]
rdrNames
qualNames :: [String]
qualNames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [String]
scopeNames forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isQualified [String]
rdrNames
#if MIN_VERSION_ghc(9,4,0)
logger <- getLogger
hsc_env <- getSession
(db, _, _, _) <- liftIO $ initUnits logger flags Nothing (hsc_all_home_unit_ids hsc_env)
let getNames = map (moduleNameString . exposedName) . unitExposedModules
moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db
#elif MIN_VERSION_ghc(9,2,0)
Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
([UnitDatabase UnitId]
db, UnitState
_, HomeUnit
_, Maybe PlatformConstants
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Maybe [UnitDatabase UnitId]
-> IO
([UnitDatabase UnitId], UnitState, HomeUnit,
Maybe PlatformConstants)
initUnits Logger
logger DynFlags
flags forall a. Maybe a
Nothing
let getNames :: GenericUnitInfo compid srcpkgid srcpkgname uid ModuleName mod
-> [String]
getNames = forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
exposedName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules
moduleNames :: [String]
moduleNames = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {compid} {srcpkgid} {srcpkgname} {uid} {mod}.
GenericUnitInfo compid srcpkgid srcpkgname uid ModuleName mod
-> [String]
getNames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall unit. UnitDatabase unit -> [GenUnitInfo unit]
unitDatabaseUnits [UnitDatabase UnitId]
db
#elif MIN_VERSION_ghc(9,0,0)
let Just db = unitDatabases flags
getNames = map (moduleNameString . exposedName) . unitExposedModules
moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db
#else
let Just db = pkgDatabase flags
getNames = map (moduleNameString . exposedName) . exposedModules
moduleNames = nub $ concatMap getNames $ concatMap snd db
#endif
let target :: [String]
target = String -> Int -> [String]
completionTarget String
line Int
pos
completion :: CompletionType
completion = String -> Int -> [String] -> CompletionType
completionType String
line Int
pos [String]
target
let matchedText :: String
matchedText =
case CompletionType
completion of
HsFilePath String
_ String
match -> String
match
FilePath String
_ String
match -> String
match
CompletionType
_ -> forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
target
[String]
options <- case CompletionType
completion of
CompletionType
Empty -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Identifier String
candidate ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
candidate forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
unqualNames
Qualified String
mName String
candidate -> do
let prefix :: String
prefix = forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String
mName, String
candidate]
completions :: [String]
completions = forall a. (a -> Bool) -> [a] -> [a]
filter (String
prefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
qualNames
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
completions
ModuleName String
previous String
candidate -> do
let prefix :: String
prefix = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
previous
then String
candidate
else forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String
previous, String
candidate]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
prefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
moduleNames
DynFlag String
ext -> do
let otherNames :: [String]
otherNames = [String
"-package", String
"-Wall", String
"-w"]
fNames :: [String]
fNames = forall a b. (a -> b) -> [a] -> [b]
map forall flag. FlagSpec flag -> String
extName [FlagSpec GeneralFlag]
fFlags forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall flag. FlagSpec flag -> String
extName [FlagSpec WarningFlag]
wWarningFlags forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
fLangFlags
fNoNames :: [String]
fNoNames = forall a b. (a -> b) -> [a] -> [b]
map (String
"no" forall a. [a] -> [a] -> [a]
++) [String]
fNames
fAllNames :: [String]
fAllNames = forall a b. (a -> b) -> [a] -> [b]
map (String
"-f" forall a. [a] -> [a] -> [a]
++) ([String]
fNames forall a. [a] -> [a] -> [a]
++ [String]
fNoNames)
xNames :: [String]
xNames = forall a b. (a -> b) -> [a] -> [b]
map forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
xFlags
xNoNames :: [String]
xNoNames = forall a b. (a -> b) -> [a] -> [b]
map (String
"No" forall a. [a] -> [a] -> [a]
++) [String]
xNames
xAllNames :: [String]
xAllNames = forall a b. (a -> b) -> [a] -> [b]
map (String
"-X" forall a. [a] -> [a] -> [a]
++) ([String]
xNames forall a. [a] -> [a] -> [a]
++ [String]
xNoNames)
allNames :: [String]
allNames = [String]
xAllNames forall a. [a] -> [a] -> [a]
++ [String]
otherNames forall a. [a] -> [a] -> [a]
++ [String]
fAllNames
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
ext forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
allNames
Extension String
ext -> do
let xNames :: [String]
xNames = forall a b. (a -> b) -> [a] -> [b]
map forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
xFlags
xNoNames :: [String]
xNoNames = forall a b. (a -> b) -> [a] -> [b]
map (String
"No" forall a. [a] -> [a] -> [a]
++) [String]
xNames
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
ext forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall a b. (a -> b) -> a -> b
$ [String]
xNames forall a. [a] -> [a] -> [a]
++ [String]
xNoNames
HsFilePath String
lineUpToCursor String
_match -> [String] -> String -> Ghc [String]
completePathWithExtensions [String
".hs", String
".lhs"]
String
lineUpToCursor
FilePath String
lineUpToCursor String
_match -> String -> Ghc [String]
completePath String
lineUpToCursor
KernelOption String
str -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (String
str forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KernelOpt -> [String]
getOptionName [KernelOpt]
kernelOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
matchedText, [String]
options)
completionType :: String
-> Int
-> [String]
-> CompletionType
completionType :: String -> Int -> [String] -> CompletionType
completionType String
line Int
loc [String]
target
| String
":!" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
(String -> String -> CompletionType) -> CompletionType
fileComplete String -> String -> CompletionType
FilePath
| String
":l" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
(String -> String -> CompletionType) -> CompletionType
fileComplete String -> String -> CompletionType
HsFilePath
| String
":s" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
String -> CompletionType
DynFlag String
candidate
| String
":o" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
String -> CompletionType
KernelOption String
candidate
| String
":e" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
String -> CompletionType
Extension String
candidate
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
target =
CompletionType
Empty
| String -> Int -> Bool
cursorInString String
line Int
loc =
String -> String -> CompletionType
FilePath (ShowS
getStringTarget String
lineUpToCursor) (ShowS
getStringTarget String
lineUpToCursor)
| String
"import" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped Bool -> Bool -> Bool
&& Bool
isModName =
String -> String -> CompletionType
ModuleName String
dotted String
candidate
| Bool
isModName Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init) [String]
target =
String -> String -> CompletionType
Qualified String
dotted String
candidate
| Bool
otherwise =
String -> CompletionType
Identifier String
candidate
where
stripped :: String
stripped = ShowS
strip String
line
dotted :: String
dotted = [String] -> String
dots [String]
target
candidate :: String
candidate
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
target = String
""
| Bool
otherwise = forall a. [a] -> a
last [String]
target
dots :: [String] -> String
dots = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init
isModName :: Bool
isModName = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isCapitalized (forall a. [a] -> [a]
init [String]
target)
isCapitalized :: String -> Bool
isCapitalized [] = Bool
False
isCapitalized (Char
x:String
_) = Char -> Bool
isUpper Char
x
lineUpToCursor :: String
lineUpToCursor = forall a. Int -> [a] -> [a]
take Int
loc String
line
fileComplete :: (String -> String -> CompletionType) -> CompletionType
fileComplete String -> String -> CompletionType
filePath =
case String -> Either ParseError [String]
parseShell String
lineUpToCursor of
Right [String]
xs -> String -> String -> CompletionType
filePath String
lineUpToCursor forall a b. (a -> b) -> a -> b
$
if forall a. [a] -> a
last [String]
xs forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
lineUpToCursor
then forall a. [a] -> a
last [String]
xs
else []
Left ParseError
_ -> CompletionType
Empty
cursorInString :: String -> Int -> Bool
cursorInString String
str Int
lcn = forall {t}. Num t => String -> t
nquotes (forall a. Int -> [a] -> [a]
take Int
lcn String
str) forall a. Integral a => a -> a -> a
`mod` Int
2 forall a. Eq a => a -> a -> Bool
/= (Int
0 :: Int)
nquotes :: String -> t
nquotes (Char
'\\':Char
'"':String
xs) = String -> t
nquotes String
xs
nquotes (Char
'"':String
xs) = t
1 forall a. Num a => a -> a -> a
+ String -> t
nquotes String
xs
nquotes (Char
_:String
xs) = String -> t
nquotes String
xs
nquotes [] = t
0
getStringTarget :: String -> String
getStringTarget :: ShowS
getStringTarget = String -> ShowS
go String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
where
go :: String -> ShowS
go String
acc String
rest =
case String
rest of
Char
'"':Char
'\\':String
xs -> String -> ShowS
go (Char
'"' forall a. a -> [a] -> [a]
: String
acc) String
xs
Char
'"':String
_ -> String
acc
Char
' ':Char
'\\':String
xs -> String -> ShowS
go (Char
' ' forall a. a -> [a] -> [a]
: String
acc) String
xs
Char
' ':String
_ -> String
acc
Char
x:String
xs -> String -> ShowS
go (Char
x forall a. a -> [a] -> [a]
: String
acc) String
xs
[] -> String
acc
completionTarget :: String -> Int -> [String]
completionTarget :: String -> Int -> [String]
completionTarget String
code Int
cursor = Maybe String -> [String]
expandCompletionPiece Maybe String
pieceToComplete
where
pieceToComplete :: Maybe String
pieceToComplete = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
cursor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) [[(Char, Int)]]
pieces
pieces :: [[(Char, Int)]]
pieces = [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor forall a b. (a -> b) -> a -> b
$ forall a. Splitter a -> [a] -> [[a]]
Split.split Splitter (Char, Int)
splitter forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip String
code [Int
1 ..]
splitter :: Splitter (Char, Int)
splitter = forall a. Splitter a
Split.defaultSplitter
{
delimiter :: Delimiter (Char, Int)
Split.delimiter = forall a. [a -> Bool] -> Delimiter a
Split.Delimiter [forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Int -> Bool
isDelim]
, condensePolicy :: CondensePolicy
Split.condensePolicy = CondensePolicy
Split.Condense
, delimPolicy :: DelimPolicy
Split.delimPolicy = DelimPolicy
Split.Drop
}
isDelim :: Char -> Int -> Bool
isDelim :: Char -> Int -> Bool
isDelim Char
char Int
_idx = Char
char forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
neverIdent Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
char
splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor [] = []
splitAlongCursor ([(Char, Int)]
x:[[(Char, Int)]]
xs) =
case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
cursor forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Char, Int)]
x of
Maybe Int
Nothing -> [(Char, Int)]
x forall a. a -> [a] -> [a]
: [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor [[(Char, Int)]]
xs
Just Int
idx -> forall a. Int -> [a] -> [a]
take (Int
idx forall a. Num a => a -> a -> a
+ Int
1) [(Char, Int)]
x forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop (Int
idx forall a. Num a => a -> a -> a
+ Int
1) [(Char, Int)]
x forall a. a -> [a] -> [a]
: [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor [[(Char, Int)]]
xs
neverIdent :: String
neverIdent :: String
neverIdent = String
" \n\t(),{}[]\\'\"`"
expandCompletionPiece :: Maybe String -> [String]
expandCompletionPiece Maybe String
Nothing = []
expandCompletionPiece (Just String
str) = forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
"." String
str
getHome :: IO String
getHome :: IO String
getHome = do
Either SomeException String
homeEither <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"HOME" :: IO (Either SomeException String)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Either SomeException String
homeEither of
Left SomeException
_ -> String
"~"
Right String
home -> String
home
dirExpand :: String -> IO String
dirExpand :: String -> IO String
dirExpand String
str = do
String
home <- IO String
getHome
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
replace String
"~" String
home String
str
unDirExpand :: String -> IO String
unDirExpand :: String -> IO String
unDirExpand String
str = do
String
home <- IO String
getHome
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
replace String
home String
"~" String
str
completePath :: String -> Interpreter [String]
completePath :: String -> Ghc [String]
completePath String
line = (String -> Bool)
-> (String -> Bool) -> String -> String -> Ghc [String]
completePathFilter forall {b}. b -> Bool
acceptAll forall {b}. b -> Bool
acceptAll String
line String
""
where
acceptAll :: b -> Bool
acceptAll = forall a b. a -> b -> a
const Bool
True
completePathWithExtensions :: [String] -> String -> Interpreter [String]
completePathWithExtensions :: [String] -> String -> Ghc [String]
completePathWithExtensions [String]
extns String
line =
(String -> Bool)
-> (String -> Bool) -> String -> String -> Ghc [String]
completePathFilter (forall {a} {t :: * -> *}.
(Eq a, Foldable t) =>
t [a] -> [a] -> Bool
extensionIsOneOf [String]
extns) forall {b}. b -> Bool
acceptAll String
line String
""
where
acceptAll :: b -> Bool
acceptAll = forall a b. a -> b -> a
const Bool
True
extensionIsOneOf :: t [a] -> [a] -> Bool
extensionIsOneOf t [a]
exts [a]
str = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [a] -> Bool
correctEnding t [a]
exts
where
correctEnding :: [a] -> Bool
correctEnding [a]
ext = [a]
ext forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [a]
str
completePathFilter :: (String -> Bool)
-> (String -> Bool)
-> String
-> String
-> Interpreter [String]
completePathFilter :: (String -> Bool)
-> (String -> Bool) -> String -> String -> Ghc [String]
completePathFilter String -> Bool
includeFile String -> Bool
includeDirectory String
left String
right = forall (m :: * -> *) a. MonadIO m => IO a -> m a
GhcMonad.liftIO forall a b. (a -> b) -> a -> b
$ do
String
expanded <- String -> IO String
dirExpand String
left
[String]
completions <- forall a b. (a -> b) -> [a] -> [b]
map Completion -> String
replacement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename (forall a. [a] -> [a]
reverse String
expanded, String
right)
[Bool]
areDirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Bool
doesDirectoryExist [String]
completions
let dirs :: [String]
dirs = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
includeDirectory forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [String]
completions [Bool]
areDirs
files :: [String]
files = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
includeFile forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [String]
completions [Bool]
areDirs
[String]
suggestions <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
unDirExpand forall a b. (a -> b) -> a -> b
$ [String]
dirs forall a. [a] -> [a] -> [a]
++ [String]
files
let isHidden :: String -> Bool
isHidden String
str = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
split String
"/" forall a b. (a -> b) -> a -> b
$
if String
"/" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
str
then forall a. [a] -> [a]
init String
str
else String
str
visible :: [String]
visible = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isHidden) [String]
suggestions
hidden :: [String]
hidden = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHidden [String]
suggestions
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
visible forall a. [a] -> [a] -> [a]
++ [String]
hidden