{-# LANGUAGE LambdaCase #-}

module Ide.Plugin.Cabal.Completion.Completer.FilePath where

import           Control.Exception                            (evaluate, try)
import           Control.Monad                                (filterM)
import           Control.Monad.Extra                          (concatForM, forM)
import qualified Data.Text                                    as T
import           Distribution.PackageDescription              (GenericPackageDescription)
import           Ide.Logger
import           Ide.Plugin.Cabal.Completion.Completer.Paths
import           Ide.Plugin.Cabal.Completion.Completer.Simple
import           Ide.Plugin.Cabal.Completion.Completer.Types
import           Ide.Plugin.Cabal.Completion.Types
import           System.Directory                             (doesDirectoryExist,
                                                               doesFileExist,
                                                               listDirectory)
import qualified System.FilePath                              as FP
import qualified System.FilePath.Posix                        as Posix
import qualified Text.Fuzzy.Parallel                          as Fuzzy

-- | Completer to be used when a file path can be completed for a field.
--  Completes file paths as well as directories.
filePathCompleter :: Completer
filePathCompleter :: Completer
filePathCompleter Recorder (WithPriority Log)
recorder CompleterData
cData = do
  let prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData
      complInfo :: PathCompletionInfo
complInfo = FilePath -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo FilePath
"" CabalPrefixInfo
prefInfo
  [FilePath]
filePathCompletions <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
complInfo
  let scored :: [Scored Text]
scored =
        Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter
          Int
Fuzzy.defChunkSize
          Int
Fuzzy.defMaxResults
          (PathCompletionInfo -> Text
pathSegment PathCompletionInfo
complInfo)
          ((FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
filePathCompletions)
  [Scored Text]
-> (Scored Text -> IO CompletionItem) -> IO [CompletionItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
    [Scored Text]
scored
    ( \Scored Text
compl' -> do
        let compl :: Text
compl = Scored Text -> Text
forall a. Scored a -> a
Fuzzy.original Scored Text
compl'
        Text
fullFilePath <- PathCompletionInfo -> Text -> IO Text
mkFilePathCompletion PathCompletionInfo
complInfo Text
compl
        CompletionItem -> IO CompletionItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionItem -> IO CompletionItem)
-> CompletionItem -> IO CompletionItem
forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text -> CompletionItem
mkCompletionItem (CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo) Text
fullFilePath Text
fullFilePath
    )

mainIsCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer
mainIsCompleter :: (Maybe Text -> GenericPackageDescription -> [FilePath])
-> Completer
mainIsCompleter Maybe Text -> GenericPackageDescription -> [FilePath]
extractionFunction Recorder (WithPriority Log)
recorder CompleterData
cData = do
  Maybe GenericPackageDescription
mGPD <- CompleterData -> IO (Maybe GenericPackageDescription)
getLatestGPD CompleterData
cData
  case Maybe GenericPackageDescription
mGPD of
    Just GenericPackageDescription
gpd -> do
      let srcDirs :: [FilePath]
srcDirs = Maybe Text -> GenericPackageDescription -> [FilePath]
extractionFunction Maybe Text
sName GenericPackageDescription
gpd
      [FilePath]
-> (FilePath -> IO [CompletionItem]) -> IO [CompletionItem]
forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM [FilePath]
srcDirs
        (\FilePath
dir' -> do
        let dir :: FilePath
dir = FilePath -> FilePath
FP.normalise FilePath
dir'
        let pathInfo :: PathCompletionInfo
pathInfo = FilePath -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo FilePath
dir CabalPrefixInfo
prefInfo
        [FilePath]
completions <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
pathInfo
        let scored :: [Scored Text]
scored = Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter
              Int
Fuzzy.defChunkSize
              Int
Fuzzy.defMaxResults
              (PathCompletionInfo -> Text
pathSegment PathCompletionInfo
pathInfo)
              ((FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
completions)
        [Scored Text]
-> (Scored Text -> IO CompletionItem) -> IO [CompletionItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
          [Scored Text]
scored
          ( \Scored Text
compl' -> do
              let compl :: Text
compl = Scored Text -> Text
forall a. Scored a -> a
Fuzzy.original Scored Text
compl'
              Text
fullFilePath <- PathCompletionInfo -> Text -> IO Text
mkFilePathCompletion PathCompletionInfo
pathInfo Text
compl
              CompletionItem -> IO CompletionItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionItem -> IO CompletionItem)
-> CompletionItem -> IO CompletionItem
forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text -> CompletionItem
mkCompletionItem (CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo) Text
fullFilePath Text
fullFilePath
          )
        )
    Maybe GenericPackageDescription
Nothing -> do
      Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug Log
LogUseWithStaleFastNoResult
      [CompletionItem] -> IO [CompletionItem]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where
    sName :: Maybe Text
sName = CompleterData -> Maybe Text
stanzaName CompleterData
cData
    prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData


-- | Completer to be used when a directory can be completed for the field.
--  Only completes directories.
directoryCompleter :: Completer
directoryCompleter :: Completer
directoryCompleter Recorder (WithPriority Log)
recorder CompleterData
cData = do
  let prefInfo :: CabalPrefixInfo
prefInfo = CompleterData -> CabalPrefixInfo
cabalPrefixInfo CompleterData
cData
      complInfo :: PathCompletionInfo
complInfo = FilePath -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo FilePath
"" CabalPrefixInfo
prefInfo
  [FilePath]
directoryCompletions <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listDirectoryCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
complInfo
  let scored :: [Scored Text]
scored =
        Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter
          Int
Fuzzy.defChunkSize
          Int
Fuzzy.defMaxResults
          (PathCompletionInfo -> Text
pathSegment PathCompletionInfo
complInfo)
          ((FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
directoryCompletions)
  [Scored Text]
-> (Scored Text -> IO CompletionItem) -> IO [CompletionItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
    [Scored Text]
scored
    ( \Scored Text
compl' -> do
        let compl :: Text
compl = Scored Text -> Text
forall a. Scored a -> a
Fuzzy.original Scored Text
compl'
        let fullDirPath :: Text
fullDirPath = PathCompletionInfo -> Text -> Text
mkPathCompletionDir PathCompletionInfo
complInfo Text
compl
        CompletionItem -> IO CompletionItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionItem -> IO CompletionItem)
-> CompletionItem -> IO CompletionItem
forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text -> CompletionItem
mkCompletionItem (CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo) Text
fullDirPath Text
fullDirPath
    )

{- Note [Using correct file path separators]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Since cabal files only allow for posix style file paths
  we need to be careful to use the correct path separators
  whenever we work with file paths in cabal files.

  Thus we are using two different kinds of imports.
  We use "FP" for platform-compatible file paths with which
  we can query files independently of the platform.
  We use "Posix" for the posix syntax paths which need to
  be used for file path completions to be written to the cabal file.
-}

-- | Takes a PathCompletionInfo and returns the list of files and directories
--  in the directory which match the path completion info in posix style.
--
--  The directories end with a posix trailing path separator.
--  Since this is used for completions to be written to the cabal file,
--  we use posix separators here.
--  See Note [Using correct file path separators].
listFileCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listFileCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
complInfo = do
  let complDir :: FilePath
complDir = PathCompletionInfo -> FilePath
mkCompletionDirectory PathCompletionInfo
complInfo
  IO [FilePath] -> IO (Either IOError [FilePath])
forall e a. Exception e => IO a -> IO (Either e a)
try ([FilePath] -> IO [FilePath]
forall a. a -> IO a
evaluate ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
complDir) IO (Either IOError [FilePath])
-> (Either IOError [FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right [FilePath]
dirs -> do
      [FilePath] -> (FilePath -> IO FilePath) -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
dirs ((FilePath -> IO FilePath) -> IO [FilePath])
-> (FilePath -> IO FilePath) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
d -> do
        Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ PathCompletionInfo -> FilePath -> FilePath
mkDirFromCWD PathCompletionInfo
complInfo FilePath
d
        FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if Bool
isDir then FilePath -> FilePath
Posix.addTrailingPathSeparator FilePath
d else FilePath
d
    Left (IOError
err :: IOError) -> do
      Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IOError -> Log
LogFilePathCompleterIOError FilePath
complDir IOError
err
      [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Returns a list of all (and only) directories in the
--  directory described by path completion info.
listDirectoryCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listDirectoryCompletions :: Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listDirectoryCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
complInfo = do
  [FilePath]
filepaths <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [FilePath]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
complInfo
  (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathCompletionInfo -> FilePath -> FilePath
mkDirFromCWD PathCompletionInfo
complInfo) [FilePath]
filepaths

-- | Returns the directory where files and directories can be queried from
--  for the passed PathCompletionInfo.
--
--  Returns the full path to the directory pointed to by the path prefix
--  by combining it with the working directory.
--
--  Since this is used for querying paths we use platform
--  compatible separators here.
--  See Note [Using correct file path separators].
mkCompletionDirectory :: PathCompletionInfo -> FilePath
mkCompletionDirectory :: PathCompletionInfo -> FilePath
mkCompletionDirectory PathCompletionInfo
complInfo =
  FilePath -> FilePath
FP.addTrailingPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
workingDirectory PathCompletionInfo
complInfo FilePath -> FilePath -> FilePath
FP.</> (FilePath -> FilePath
FP.normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ PathCompletionInfo -> FilePath
queryDirectory PathCompletionInfo
complInfo)

-- | Returns the full path for the given path segment
--  by combining the working directory with the path prefix
--  and the path segment.
--
--  Since this is used for querying paths we use platform
--  compatible separators here.
--  See Note [Using correct file path separators].
mkDirFromCWD :: PathCompletionInfo -> FilePath -> FilePath
mkDirFromCWD :: PathCompletionInfo -> FilePath -> FilePath
mkDirFromCWD PathCompletionInfo
complInfo FilePath
fp =
  FilePath -> FilePath
FP.addTrailingPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
mkCompletionDirectory PathCompletionInfo
complInfo FilePath -> FilePath -> FilePath
FP.</> FilePath -> FilePath
FP.normalise FilePath
fp

-- | Takes a PathCompletionInfo and a directory and
--  returns the complete cabal path to be written on completion action
--  by combining the previously written path prefix and the completed
--  path segment.
--
--  Since this is used for completions we use posix separators here.
--  See Note [Using correct file path separators].
mkPathCompletionDir :: PathCompletionInfo -> T.Text -> T.Text
mkPathCompletionDir :: PathCompletionInfo -> Text -> Text
mkPathCompletionDir PathCompletionInfo
complInfo Text
completion =
  FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
queryDirectory PathCompletionInfo
complInfo FilePath -> FilePath -> FilePath
Posix.</> Text -> FilePath
T.unpack Text
completion

-- | Takes a PathCompletionInfo and a completed path segment and
--  generates the whole filepath to be completed.
--
--  The returned text combines the completion with a relative path
--  generated from a possible previously written path prefix and
--  is relative to the cabal file location.
--
--  If the completion results in a filepath, we know this is a
--  completed path and can thus apply wrapping of apostrophes if needed.
mkFilePathCompletion :: PathCompletionInfo -> T.Text -> IO T.Text
mkFilePathCompletion :: PathCompletionInfo -> Text -> IO Text
mkFilePathCompletion PathCompletionInfo
complInfo Text
completion = do
  let combinedPath :: Text
combinedPath = PathCompletionInfo -> Text -> Text
mkPathCompletionDir PathCompletionInfo
complInfo Text
completion
  Bool
isFilePath <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
combinedPath
  let completedPath :: Text
completedPath = if Bool
isFilePath then Maybe Apostrophe -> Text -> Text
applyStringNotation (PathCompletionInfo -> Maybe Apostrophe
isStringNotationPath PathCompletionInfo
complInfo) Text
combinedPath else Text
combinedPath
  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
completedPath