{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import           Control.Exception                            (evaluate, try)
import           Control.Monad                                (filterM)
import           Control.Monad.Extra                          (forM)
import qualified Data.Text                                    as T
import           Ide.Logger
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 = CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo 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)
          (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
filePathCompletions)
  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 = forall a. Scored a -> a
Fuzzy.original Scored Text
compl'
        Text
fullFilePath <- PathCompletionInfo -> Text -> IO Text
mkFilePathCompletion PathCompletionInfo
complInfo Text
compl
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Range -> Text -> Text -> CompletionItem
mkCompletionItem (CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo) Text
fullFilePath Text
fullFilePath
    )

-- | 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 = CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo 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)
          (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
directoryCompletions)
  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 = forall a. Scored a -> a
Fuzzy.original Scored Text
compl'
        let fullDirPath :: Text
fullDirPath = PathCompletionInfo -> Text -> Text
mkPathCompletionDir PathCompletionInfo
complInfo Text
compl
        forall (f :: * -> *) a. Applicative f => a -> f a
pure 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.
-}

-- | Information used to query and build path completions.
--
--  Note that pathSegment  combined with queryDirectory  results in
--  the original prefix.
--
--  Example:
--  When given the written prefix, @dir1\/dir2\/fi@, the
--  resulting PathCompletionInfo would be:
--
--  @
--    pathSegment = "fi"
--    queryDirectory  = "dir1\/dir2\/fi"
--    ...
--  @
data PathCompletionInfo = PathCompletionInfo
  { -- | partly written segment of the next part of the path
    PathCompletionInfo -> Text
pathSegment          :: T.Text,
    -- | written part of path, platform dependent
    PathCompletionInfo -> FilePath
queryDirectory       :: FilePath,
    -- | directory relative to which relative paths are interpreted, platform dependent
    PathCompletionInfo -> FilePath
workingDirectory     :: FilePath,
    -- | Did the completion happen in the context of a string notation,
    -- if yes, contains the state of the string notation
    PathCompletionInfo -> Maybe Apostrophe
isStringNotationPath :: Maybe Apostrophe
  }
  deriving (PathCompletionInfo -> PathCompletionInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathCompletionInfo -> PathCompletionInfo -> Bool
$c/= :: PathCompletionInfo -> PathCompletionInfo -> Bool
== :: PathCompletionInfo -> PathCompletionInfo -> Bool
$c== :: PathCompletionInfo -> PathCompletionInfo -> Bool
Eq, Int -> PathCompletionInfo -> ShowS
[PathCompletionInfo] -> ShowS
PathCompletionInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PathCompletionInfo] -> ShowS
$cshowList :: [PathCompletionInfo] -> ShowS
show :: PathCompletionInfo -> FilePath
$cshow :: PathCompletionInfo -> FilePath
showsPrec :: Int -> PathCompletionInfo -> ShowS
$cshowsPrec :: Int -> PathCompletionInfo -> ShowS
Show)

-- | 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
  forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
complDir) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right [FilePath]
dirs -> do
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
dirs forall a b. (a -> b) -> a -> b
$ \FilePath
d -> do
        Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist forall a b. (a -> b) -> a -> b
$ PathCompletionInfo -> ShowS
mkDirFromCWD PathCompletionInfo
complInfo FilePath
d
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
isDir then ShowS
Posix.addTrailingPathSeparator FilePath
d else FilePath
d
    Left (IOError
err :: IOError) -> do
      forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning forall a b. (a -> b) -> a -> b
$ FilePath -> IOError -> Log
LogFilePathCompleterIOError FilePath
complDir IOError
err
      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
  forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathCompletionInfo -> ShowS
mkDirFromCWD PathCompletionInfo
complInfo) [FilePath]
filepaths

pathCompletionInfoFromCabalPrefixInfo :: CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo :: CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo CabalPrefixInfo
ctx =
  PathCompletionInfo
    { pathSegment :: Text
pathSegment = FilePath -> Text
T.pack FilePath
pathSegment',
      queryDirectory :: FilePath
queryDirectory = FilePath
queryDirectory',
      workingDirectory :: FilePath
workingDirectory = CabalPrefixInfo -> FilePath
completionWorkingDir CabalPrefixInfo
ctx,
      isStringNotationPath :: Maybe Apostrophe
isStringNotationPath = CabalPrefixInfo -> Maybe Apostrophe
isStringNotation CabalPrefixInfo
ctx
    }
  where
    prefix :: FilePath
prefix = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
ctx
    (FilePath
queryDirectory', FilePath
pathSegment') = FilePath -> (FilePath, FilePath)
Posix.splitFileName FilePath
prefix

-- | 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 =
  ShowS
FP.addTrailingPathSeparator forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
workingDirectory PathCompletionInfo
complInfo FilePath -> ShowS
FP.</> (ShowS
FP.normalise 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 -> ShowS
mkDirFromCWD PathCompletionInfo
complInfo FilePath
fp =
  ShowS
FP.addTrailingPathSeparator forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
mkCompletionDirectory PathCompletionInfo
complInfo FilePath -> ShowS
FP.</> ShowS
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 forall a b. (a -> b) -> a -> b
$
    PathCompletionInfo -> FilePath
queryDirectory PathCompletionInfo
complInfo FilePath -> ShowS
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 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
completedPath