{-# 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 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
(Int -> CompletionType -> ShowS)
-> (CompletionType -> String)
-> ([CompletionType] -> ShowS)
-> Show CompletionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionType -> ShowS
showsPrec :: Int -> CompletionType -> ShowS
$cshow :: CompletionType -> String
show :: CompletionType -> String
$cshowList :: [CompletionType] -> ShowS
showList :: [CompletionType] -> ShowS
Show, CompletionType -> CompletionType -> Bool
(CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool) -> Eq CompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
/= :: CompletionType -> CompletionType -> Bool
Eq)

exposedName :: (a, b) -> a
exposedName :: forall a b. (a, b) -> a
exposedName = (a, b) -> a
forall a b. (a, b) -> a
fst

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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
first
          then (Int
offset, String
first)
          else Int -> [String] -> (Int, String)
findLine (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
first Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String]
rest
      findLine Int
_ [] = String -> (Int, String)
forall a. HasCallStack => String -> a
error (String -> (Int, String)) -> String -> (Int, String)
forall a b. (a -> b) -> a -> b
$ String
"Could not find line: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Int], Int) -> String
forall a. Show a => a -> String
show ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> [Int]) -> [String] -> [Int]
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 <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
  [String]
rdrNames <- (RdrName -> String) -> [RdrName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> RdrName -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
flags) ([RdrName] -> [String]) -> Ghc [RdrName] -> Ghc [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc [RdrName]
forall (m :: * -> *). GhcMonad m => m [RdrName]
getRdrNamesInScope
  [String]
scopeNames <- [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([Name] -> [String]) -> [Name] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> Name -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
flags) ([Name] -> [String]) -> Ghc [Name] -> Ghc [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc [Name]
forall (m :: * -> *). GhcMonad m => m [Name]
getNamesInScope
  let isQualified :: String -> Bool
isQualified = (Char
'.' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
      unqualNames :: [String]
unqualNames = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isQualified) [String]
rdrNames
      qualNames :: [String]
qualNames = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
scopeNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isQualified [String]
rdrNames
#if MIN_VERSION_ghc(9,4,0)
  Logger
logger <- Ghc Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
  HscEnv
hsc_env <- Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  ([UnitDatabase UnitId]
db, UnitState
_, HomeUnit
_, Maybe PlatformConstants
_) <- IO
  ([UnitDatabase UnitId], UnitState, HomeUnit,
   Maybe PlatformConstants)
-> Ghc
     ([UnitDatabase UnitId], UnitState, HomeUnit,
      Maybe PlatformConstants)
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ([UnitDatabase UnitId], UnitState, HomeUnit,
    Maybe PlatformConstants)
 -> Ghc
      ([UnitDatabase UnitId], UnitState, HomeUnit,
       Maybe PlatformConstants))
-> IO
     ([UnitDatabase UnitId], UnitState, HomeUnit,
      Maybe PlatformConstants)
-> Ghc
     ([UnitDatabase UnitId], UnitState, HomeUnit,
      Maybe PlatformConstants)
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Maybe [UnitDatabase UnitId]
-> Set UnitId
-> IO
     ([UnitDatabase UnitId], UnitState, HomeUnit,
      Maybe PlatformConstants)
initUnits Logger
logger DynFlags
flags Maybe [UnitDatabase UnitId]
forall a. Maybe a
Nothing (HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env)
  let getNames :: GenericUnitInfo srcpkgid srcpkgname uid ModuleName mod -> [String]
getNames = ((ModuleName, Maybe mod) -> String)
-> [(ModuleName, Maybe mod)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> String
moduleNameString (ModuleName -> String)
-> ((ModuleName, Maybe mod) -> ModuleName)
-> (ModuleName, Maybe mod)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, Maybe mod) -> ModuleName
forall a b. (a, b) -> a
exposedName) ([(ModuleName, Maybe mod)] -> [String])
-> (GenericUnitInfo srcpkgid srcpkgname uid ModuleName mod
    -> [(ModuleName, Maybe mod)])
-> GenericUnitInfo srcpkgid srcpkgname uid ModuleName mod
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericUnitInfo srcpkgid srcpkgname uid ModuleName mod
-> [(ModuleName, Maybe mod)]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules
      moduleNames :: [String]
moduleNames = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (GenericUnitInfo
   PackageId
   PackageName
   UnitId
   ModuleName
   (GenModule (GenUnit UnitId))
 -> [String])
-> [GenericUnitInfo
      PackageId
      PackageName
      UnitId
      ModuleName
      (GenModule (GenUnit UnitId))]
-> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenericUnitInfo
  PackageId
  PackageName
  UnitId
  ModuleName
  (GenModule (GenUnit UnitId))
-> [String]
forall {srcpkgid} {srcpkgname} {uid} {mod}.
GenericUnitInfo srcpkgid srcpkgname uid ModuleName mod -> [String]
getNames ([GenericUnitInfo
    PackageId
    PackageName
    UnitId
    ModuleName
    (GenModule (GenUnit UnitId))]
 -> [String])
-> [GenericUnitInfo
      PackageId
      PackageName
      UnitId
      ModuleName
      (GenModule (GenUnit UnitId))]
-> [String]
forall a b. (a -> b) -> a -> b
$ (UnitDatabase UnitId
 -> [GenericUnitInfo
       PackageId
       PackageName
       UnitId
       ModuleName
       (GenModule (GenUnit UnitId))])
-> [UnitDatabase UnitId]
-> [GenericUnitInfo
      PackageId
      PackageName
      UnitId
      ModuleName
      (GenModule (GenUnit UnitId))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitDatabase UnitId
-> [GenericUnitInfo
      PackageId
      PackageName
      UnitId
      ModuleName
      (GenModule (GenUnit UnitId))]
forall unit. UnitDatabase unit -> [GenUnitInfo unit]
unitDatabaseUnits [UnitDatabase UnitId]
db
#elif MIN_VERSION_ghc(9,2,0)
  logger <- getLogger
  (db, _, _, _) <- liftIO $ initUnits logger flags Nothing
  let getNames = map (moduleNameString . exposedName) . unitExposedModules
      moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits 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
_                  -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
target

  [String]
options <- case CompletionType
completion of
               CompletionType
Empty -> [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return []

               Identifier String
candidate ->
                 [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Ghc [String]) -> [String] -> Ghc [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
candidate String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
unqualNames

               Qualified String
mName String
candidate -> do
                 let prefix :: String
prefix = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String
mName, String
candidate]
                     completions :: [String]
completions = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
qualNames
                 [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
completions

               ModuleName String
previous String
candidate -> do
                 let prefix :: String
prefix = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
previous
                                then String
candidate
                                else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String
previous, String
candidate]
                 [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Ghc [String]) -> [String] -> Ghc [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
prefix String -> String -> Bool
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 = (FlagSpec GeneralFlag -> String)
-> [FlagSpec GeneralFlag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagSpec GeneralFlag -> String
forall flag. FlagSpec flag -> String
extName [FlagSpec GeneralFlag]
fFlags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                              (FlagSpec WarningFlag -> String)
-> [FlagSpec WarningFlag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagSpec WarningFlag -> String
forall flag. FlagSpec flag -> String
extName [FlagSpec WarningFlag]
wWarningFlags [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                              (FlagSpec Extension -> String) -> [FlagSpec Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagSpec Extension -> String
forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
fLangFlags
                     fNoNames :: [String]
fNoNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"no" String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
fNames
                     fAllNames :: [String]
fAllNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-f" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String]
fNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
fNoNames)

                     xNames :: [String]
xNames = (FlagSpec Extension -> String) -> [FlagSpec Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagSpec Extension -> String
forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
xFlags
                     xNoNames :: [String]
xNoNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"No" String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
xNames
                     xAllNames :: [String]
xAllNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-X" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String]
xNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xNoNames)

                     allNames :: [String]
allNames = [String]
xAllNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
otherNames [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
fAllNames

                 [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Ghc [String]) -> [String] -> Ghc [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
ext String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
allNames

               Extension String
ext -> do
                 let xNames :: [String]
xNames = (FlagSpec Extension -> String) -> [FlagSpec Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FlagSpec Extension -> String
forall flag. FlagSpec flag -> String
extName [FlagSpec Extension]
xFlags
                     xNoNames :: [String]
xNoNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"No" String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
xNames
                 [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Ghc [String]) -> [String] -> Ghc [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
ext String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
xNames [String] -> [String] -> [String]
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 -> [String] -> Ghc [String]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Ghc [String]) -> [String] -> Ghc [String]
forall a b. (a -> b) -> a -> b
$
                 (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
str String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ((KernelOpt -> [String]) -> [KernelOpt] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap KernelOpt -> [String]
getOptionName [KernelOpt]
kernelOpts)

  (String, [String]) -> Interpreter (String, [String])
forall a. a -> Ghc a
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
":!" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
      (String -> String -> CompletionType) -> CompletionType
fileComplete String -> String -> CompletionType
FilePath
  | String
":l" String -> String -> Bool
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" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
      String -> CompletionType
DynFlag String
candidate
  | String
":o" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
stripped =
      String -> CompletionType
KernelOption String
candidate
  | String
":e" String -> String -> Bool
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.
  | [String] -> Bool
forall a. [a] -> Bool
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" String -> String -> Bool
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 (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. HasCallStack => [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
      | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
target = String
""
      | Bool
otherwise = [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
target
    dots :: [String] -> String
dots = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. HasCallStack => [a] -> [a]
init
    isModName :: Bool
isModName = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isCapitalized ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
target)

    isCapitalized :: String -> Bool
isCapitalized [] = Bool
False
    isCapitalized (Char
x:String
_) = Char -> Bool
isUpper Char
x

    lineUpToCursor :: String
lineUpToCursor = Int -> ShowS
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 (String -> CompletionType) -> String -> CompletionType
forall a b. (a -> b) -> a -> b
$
          if [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
lineUpToCursor
            then [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
xs
            else []
        Left ParseError
_ -> CompletionType
Empty

    cursorInString :: String -> Int -> Bool
cursorInString String
str Int
lcn = String -> Int
forall {t}. Num t => String -> t
nquotes (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
lcn String
str) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
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 t -> t -> t
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
"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
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
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
xs
            Char
'"':String
_       -> String
acc
            Char
' ':Char
'\\':String
xs -> String -> ShowS
go (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
xs
            Char
' ':String
_       -> String
acc
            Char
x:String
xs        -> String -> ShowS
go (Char
x Char -> ShowS
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 = ((Char, Int) -> Char) -> [(Char, Int)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Int) -> Char
forall a b. (a, b) -> a
fst ([(Char, Int)] -> String) -> Maybe [(Char, Int)] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Char, Int)] -> Bool) -> [[(Char, Int)]] -> Maybe [(Char, Int)]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
cursor ([Int] -> Bool)
-> ([(Char, Int)] -> [Int]) -> [(Char, Int)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Int) -> Int) -> [(Char, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Int) -> Int
forall a b. (a, b) -> b
snd) [[(Char, Int)]]
pieces
    pieces :: [[(Char, Int)]]
pieces = [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor ([[(Char, Int)]] -> [[(Char, Int)]])
-> [[(Char, Int)]] -> [[(Char, Int)]]
forall a b. (a -> b) -> a -> b
$ Splitter (Char, Int) -> [(Char, Int)] -> [[(Char, Int)]]
forall a. Splitter a -> [a] -> [[a]]
Split.split Splitter (Char, Int)
splitter ([(Char, Int)] -> [[(Char, Int)]])
-> [(Char, Int)] -> [[(Char, Int)]]
forall a b. (a -> b) -> a -> b
$ String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
code [Int
1 ..]
    splitter :: Splitter (Char, Int)
splitter = Splitter Any
forall a. Splitter a
Split.defaultSplitter
      {
      -- Split using only the characters, which are the first elements of the (char, index) tuple
      Split.delimiter = Split.Delimiter [uncurry isDelim]
      -- Condense multiple delimiters into one and then drop them.
      , Split.condensePolicy = Split.Condense
      , Split.delimPolicy = Split.Drop
      }

    isDelim :: Char -> Int -> Bool
    isDelim :: Char -> Int -> Bool
isDelim Char
char Int
_idx = Char
char Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
cursor ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Char, Int) -> Int) -> [(Char, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Int) -> Int
forall a b. (a, b) -> b
snd [(Char, Int)]
x of
        Maybe Int
Nothing  -> [(Char, Int)]
x [(Char, Int)] -> [[(Char, Int)]] -> [[(Char, Int)]]
forall a. a -> [a] -> [a]
: [[(Char, Int)]] -> [[(Char, Int)]]
splitAlongCursor [[(Char, Int)]]
xs
        Just Int
idx -> Int -> [(Char, Int)] -> [(Char, Int)]
forall a. Int -> [a] -> [a]
take (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Char, Int)]
x [(Char, Int)] -> [[(Char, Int)]] -> [[(Char, Int)]]
forall a. a -> [a] -> [a]
: Int -> [(Char, Int)] -> [(Char, Int)]
forall a. Int -> [a] -> [a]
drop (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Char, Int)]
x [(Char, Int)] -> [[(Char, Int)]] -> [[(Char, Int)]]
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) = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
"." String
str

getHome :: IO String
getHome :: IO String
getHome = do
  Either SomeException String
homeEither <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"HOME" :: IO (Either SomeException String)
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
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
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
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
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
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 String -> Bool
forall {b}. b -> Bool
acceptAll String -> Bool
forall {b}. b -> Bool
acceptAll String
line String
""
  where
    acceptAll :: b -> Bool
acceptAll = Bool -> b -> Bool
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 ([String] -> String -> Bool
forall {a} {t :: * -> *}.
(Eq a, Foldable t) =>
t [a] -> [a] -> Bool
extensionIsOneOf [String]
extns) String -> Bool
forall {b}. b -> Bool
acceptAll String
line String
""
  where
    acceptAll :: b -> Bool
acceptAll = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
    extensionIsOneOf :: t [a] -> [a] -> Bool
extensionIsOneOf t [a]
exts [a]
str = ([a] -> Bool) -> t [a] -> Bool
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 [a] -> [a] -> Bool
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 = IO [String] -> Ghc [String]
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GhcMonad.liftIO (IO [String] -> Ghc [String]) -> IO [String] -> Ghc [String]
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 <- (Completion -> String) -> [Completion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> String
replacement ([Completion] -> [String])
-> ((String, [Completion]) -> [Completion])
-> (String, [Completion])
-> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String, [Completion]) -> [Completion]
forall a b. (a, b) -> b
snd ((String, [Completion]) -> [String])
-> IO (String, [Completion]) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompletionFunc IO
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename (ShowS
forall a. [a] -> [a]
reverse String
expanded, String
right)

  -- Split up into files and directories. Filter out ones we don't want.
  [Bool]
areDirs <- (String -> IO Bool) -> [String] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO Bool
doesDirectoryExist [String]
completions
  let dirs :: [String]
dirs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
includeDirectory ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
completions [Bool]
areDirs
      files :: [String]
files = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
includeFile ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, Bool) -> Bool) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> Bool
forall a b. (a, b) -> b
snd) ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Bool] -> [(String, Bool)]
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 <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO String
unDirExpand ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
dirs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
files
  let isHidden :: String -> Bool
isHidden String
str = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"." (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. HasCallStack => [a] -> a
last ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
split String
"/" (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$
        if String
"/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
str
          then ShowS
forall a. HasCallStack => [a] -> [a]
init String
str
          else String
str
      visible :: [String]
visible = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isHidden) [String]
suggestions
      hidden :: [String]
hidden = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHidden [String]
suggestions
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
visible [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hidden