{-# LANGUAGE CPP, NoImplicitPrelude, DoAndIfThenElse, TypeFamilies, FlexibleContexts #-}

{- |
Description:    Generates tab completion options.

This has a limited amount of context sensitivity. It distinguishes between four contexts at the moment:
- import statements (completed using modules)
- identifiers (completed using in scope values)
- extensions via :ext (completed using GHC extensions)
- qualified identifiers (completed using in-scope values)

-}
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
#if 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
  -- Get the line of code which is being completed and offset within that line
  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,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
                 -- Possibly leave out the fLangFlags?
                 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)


-- | Get which type of completion this is from the surrounding context.
completionType :: String            -- ^ The line on which the completion is being done.
               -> Int                -- ^ Location of the cursor in the line.
               -> [String]          -- ^ The identifier being completed (pieces separated by dots).
               -> CompletionType
completionType :: String -> Int -> [String] -> CompletionType
completionType String
line Int
loc [String]
target
  -- File and directory completions are special
  | 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

  -- Complete :set, :opt, and :ext
  | 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

  -- Use target for other completions. If it's empty, no completion.
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
target =
      CompletionType
Empty

  -- When in a string, complete filenames.
  | String -> Int -> Bool
cursorInString String
line Int
loc =
      String -> String -> CompletionType
FilePath (ShowS
getStringTarget String
lineUpToCursor) (ShowS
getStringTarget String
lineUpToCursor)

  -- Complete module names in imports and elsewhere.
  | 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

  -- Default to completing identifiers.
  | 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

    -- Get the bit of a string that might be a filename completion. Logic is a bit convoluted, but
    -- basically go backwards from the end, stopping at any quote or space, unless they are escaped.
    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

-- | Get the word under a given cursor location.
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
      {
      -- Split using only the characters, which are the first elements of the (char, index) tuple
      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]
      -- Condense multiple delimiters into one and then drop them.
      , 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

    -- These are never part of an identifier.
    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)      -- ^ File filter: test whether to include this file.
                   -> (String -> Bool)      -- ^ Directory filter: test whether to include this directory.
                   -> String               -- ^ Line contents to the left of the cursor.
                   -> String               -- ^ Line contents to the right of the cursor.
                   -> 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
  -- Get the completions from Haskeline.  It has a bit of a strange API.
  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)

  -- Split up into files and directories. Filter out ones we don't want.
  [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

  -- Return directories before files. However, stick everything that starts with a dot after
  -- everything else. If we wanted to keep original order, we could instead use
  --   filter (`elem` (dirs ++ files)) completions
  [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