{-# LANGUAGE OverloadedStrings #-}

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

import           Control.Monad                                  (filterM)
import           Control.Monad.Extra                            (concatForM,
                                                                 forM)
import           Data.List                                      (stripPrefix)
import qualified Data.List                                      as List
import           Data.Maybe                                     (fromMaybe)
import qualified Data.Text                                      as T
import           Distribution.PackageDescription                (Benchmark (..),
                                                                 BuildInfo (..),
                                                                 CondTree (condTreeData),
                                                                 Executable (..),
                                                                 GenericPackageDescription (..),
                                                                 Library (..),
                                                                 UnqualComponentName,
                                                                 mkUnqualComponentName,
                                                                 testBuildInfo)
import           Distribution.Utils.Path                        (getSymbolicPath)
import           Ide.Logger                                     (Priority (..),
                                                                 Recorder,
                                                                 WithPriority,
                                                                 logWith)
import           Ide.Plugin.Cabal.Completion.Completer.FilePath (PathCompletionInfo (..),
                                                                 listFileCompletions,
                                                                 mkCompletionDirectory)
import           Ide.Plugin.Cabal.Completion.Completer.Simple
import           Ide.Plugin.Cabal.Completion.Completer.Types
import           Ide.Plugin.Cabal.Completion.Types
import           System.Directory                               (doesFileExist)
import qualified System.FilePath                                as FP
import qualified Text.Fuzzy.Parallel                            as Fuzzy

-- | Completer to be used when module paths can be completed for the field.
--
-- Takes an extraction function which extracts the source directories
-- to be used by the completer.
modulesCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer
modulesCompleter :: (Maybe Text -> GenericPackageDescription -> [String]) -> Completer
modulesCompleter Maybe Text -> GenericPackageDescription -> [String]
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 sourceDirs :: [String]
sourceDirs = Maybe Text -> GenericPackageDescription -> [String]
extractionFunction Maybe Text
sName GenericPackageDescription
gpd
      [Text]
filePathCompletions <-
        Recorder (WithPriority Log)
-> [String] -> CabalPrefixInfo -> IO [Text]
filePathsForExposedModules Recorder (WithPriority Log)
recorder [String]
sourceDirs CabalPrefixInfo
prefInfo
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Text
compl -> Range -> Text -> CompletionItem
mkSimpleCompletionItem (CabalPrefixInfo -> Range
completionRange CabalPrefixInfo
prefInfo) Text
compl) [Text]
filePathCompletions
    Maybe GenericPackageDescription
Nothing -> do
      forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug Log
LogUseWithStaleFastNoResult
      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

-- | Extracts the source directories of the library stanza.
sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
sourceDirsExtractionLibrary :: Maybe Text -> GenericPackageDescription -> [String]
sourceDirsExtractionLibrary Maybe Text
Nothing GenericPackageDescription
gpd =
  -- we use condLibrary to get the information contained in the library stanza
  -- since the library in PackageDescription is not populated by us
  case Maybe (CondTree ConfVar [Dependency] Library)
libM of
    Just CondTree ConfVar [Dependency] Library
lib -> do
      forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo forall a b. (a -> b) -> a -> b
$ forall v c a. CondTree v c a -> a
condTreeData CondTree ConfVar [Dependency] Library
lib
    Maybe (CondTree ConfVar [Dependency] Library)
Nothing -> []
  where
    libM :: Maybe (CondTree ConfVar [Dependency] Library)
libM = GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
gpd
sourceDirsExtractionLibrary Maybe Text
name GenericPackageDescription
gpd = forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [String]
extractRelativeDirsFromStanza Maybe Text
name GenericPackageDescription
gpd GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries Library -> BuildInfo
libBuildInfo

-- | Extracts the source directories of the executable stanza with the given name.
sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
sourceDirsExtractionExecutable :: Maybe Text -> GenericPackageDescription -> [String]
sourceDirsExtractionExecutable Maybe Text
name GenericPackageDescription
gpd = forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [String]
extractRelativeDirsFromStanza Maybe Text
name GenericPackageDescription
gpd GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables Executable -> BuildInfo
buildInfo

-- | Extracts the source directories of the test suite stanza with the given name.
sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
sourceDirsExtractionTestSuite :: Maybe Text -> GenericPackageDescription -> [String]
sourceDirsExtractionTestSuite Maybe Text
name GenericPackageDescription
gpd = forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [String]
extractRelativeDirsFromStanza Maybe Text
name GenericPackageDescription
gpd GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites TestSuite -> BuildInfo
testBuildInfo

-- | Extracts the source directories of benchmark stanza with the given name.
sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
sourceDirsExtractionBenchmark :: Maybe Text -> GenericPackageDescription -> [String]
sourceDirsExtractionBenchmark Maybe Text
name GenericPackageDescription
gpd = forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [String]
extractRelativeDirsFromStanza Maybe Text
name GenericPackageDescription
gpd GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks Benchmark -> BuildInfo
benchmarkBuildInfo

-- | Takes a possible stanza name, a GenericPackageDescription,
--  a function to access the stanza information we are interested in
--  and a function to access the build info from the specific stanza.
--
--  Returns a list of relative source directory paths specified for the extracted stanza.
extractRelativeDirsFromStanza ::
  Maybe StanzaName ->
  GenericPackageDescription ->
  (GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) ->
  (a -> BuildInfo) ->
  [FilePath]
extractRelativeDirsFromStanza :: forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [String]
extractRelativeDirsFromStanza Maybe Text
Nothing GenericPackageDescription
_ GenericPackageDescription
-> [(UnqualComponentName, CondTree b c a)]
_ a -> BuildInfo
_ = []
extractRelativeDirsFromStanza (Just Text
name) GenericPackageDescription
gpd GenericPackageDescription
-> [(UnqualComponentName, CondTree b c a)]
getStanza a -> BuildInfo
getBuildInfo
  | Just a
stanza <- Maybe a
stanzaM = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs forall a b. (a -> b) -> a -> b
$ a -> BuildInfo
getBuildInfo a
stanza
  | Bool
otherwise = []
  where
    stanzaM :: Maybe a
stanzaM = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v c a. CondTree v c a -> a
condTreeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (UnqualComponentName, CondTree b c a)
res
    allStanzasM :: [(UnqualComponentName, CondTree b c a)]
allStanzasM = GenericPackageDescription
-> [(UnqualComponentName, CondTree b c a)]
getStanza GenericPackageDescription
gpd
    res :: Maybe (UnqualComponentName, CondTree b c a)
res =
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
        ( \(UnqualComponentName
n, CondTree b c a
_) ->
            UnqualComponentName
n forall a. Eq a => a -> a -> Bool
== String -> UnqualComponentName
mkUnqualComponentName (Text -> String
T.unpack Text
name)
        )
        [(UnqualComponentName, CondTree b c a)]
allStanzasM

-- | Takes a list of source directories and returns a list of path completions
--  relative to any of the passed source directories which fit the passed prefix info.
filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [T.Text]
filePathsForExposedModules :: Recorder (WithPriority Log)
-> [String] -> CabalPrefixInfo -> IO [Text]
filePathsForExposedModules Recorder (WithPriority Log)
recorder [String]
srcDirs CabalPrefixInfo
prefInfo = do
  forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM
    [String]
srcDirs
    ( \String
dir' -> do
        let dir :: String
dir = String -> String
FP.normalise String
dir'
        let pInfo :: PathCompletionInfo
pInfo =
              PathCompletionInfo
                { isStringNotationPath :: Maybe Apostrophe
isStringNotationPath = forall a. Maybe a
Nothing,
                  pathSegment :: Text
pathSegment = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
FP.takeFileName String
prefix,
                  queryDirectory :: String
queryDirectory = String -> String
FP.addTrailingPathSeparator forall a b. (a -> b) -> a -> b
$ String -> String
FP.takeDirectory String
prefix,
                  workingDirectory :: String
workingDirectory = CabalPrefixInfo -> String
completionWorkingDir CabalPrefixInfo
prefInfo String -> String -> String
FP.</> String
dir
                }
        [String]
completions <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [String]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
pInfo
        [String]
validExposedCompletions <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (PathCompletionInfo -> String -> IO Bool
isValidExposedModulePath PathCompletionInfo
pInfo) [String]
completions
        let toMatch :: Text
toMatch = PathCompletionInfo -> Text
pathSegment PathCompletionInfo
pInfo
            scored :: [Scored Text]
scored = Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter Int
Fuzzy.defChunkSize Int
Fuzzy.defMaxResults Text
toMatch (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
validExposedCompletions)
        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 -> String -> IO Text
mkExposedModulePathCompletion PathCompletionInfo
pInfo forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
compl
              forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
fullFilePath
          )
    )
  where
    prefix :: String
prefix =
      Text -> String
exposedModulePathToFp forall a b. (a -> b) -> a -> b
$
        CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo
    -- \| Takes a PathCompletionInfo and a path segment and checks whether
    --    the path segment can be completed for an exposed module.
    --
    --    This is the case if the segment represents either a directory or a Haskell file.
    --
    isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool
    isValidExposedModulePath :: PathCompletionInfo -> String -> IO Bool
isValidExposedModulePath PathCompletionInfo
pInfo String
path = do
      let dir :: String
dir = PathCompletionInfo -> String
mkCompletionDirectory PathCompletionInfo
pInfo
      Bool
fileExists <- String -> IO Bool
doesFileExist (String
dir String -> String -> String
FP.</> String
path)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
fileExists Bool -> Bool -> Bool
|| String -> String
FP.takeExtension String
path forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".hs", String
".lhs"]

-- | Takes a pathCompletionInfo and a path segment and generates the whole
--  filepath to be written on completion including a possibly already written prefix;
--  using the cabal syntax for exposed modules.
--
--  Examples:
--  When the partial directory path `Dir.Dir2.` is stored in the PathCompletionInfo
--  and the completed file `HaskellFile.hs` is passed along with that PathCompletionInfo,
--  the result would be `Dir1.Dir2.HaskellFile`
--
--  When the partial directory path `Dir.` is stored in the PathCompletionInfo
--  and the completed directory `Dir2` is passed along with that PathCompletionInfo,
--  the result would be `Dir1.Dir2.`
mkExposedModulePathCompletion :: PathCompletionInfo -> FilePath -> IO T.Text
mkExposedModulePathCompletion :: PathCompletionInfo -> String -> IO Text
mkExposedModulePathCompletion PathCompletionInfo
complInfo String
completion = do
  let combinedPath :: String
combinedPath = PathCompletionInfo -> String
queryDirectory PathCompletionInfo
complInfo String -> String -> String
FP.</> String
completion
  Bool
isFilePath <- String -> IO Bool
doesFileExist (PathCompletionInfo -> String
workingDirectory PathCompletionInfo
complInfo String -> String -> String
FP.</> String
combinedPath)
  let addTrailingDot :: p -> p
addTrailingDot p
modPath = if Bool
isFilePath then p
modPath else p
modPath forall a. Semigroup a => a -> a -> a
<> p
"."
  let exposedPath :: String
exposedPath = String -> String -> String
FP.makeRelative String
"." String
combinedPath
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {p}. (Semigroup p, IsString p) => p -> p
addTrailingDot forall a b. (a -> b) -> a -> b
$ String -> String -> Text
fpToExposedModulePath String
"" String
exposedPath

-- | Takes a source directory path and a module path and returns
--  the module path relative to the source directory
--  in exposed module syntax where the separators are '.'
--  and the file ending is removed.
--
-- Synopsis: @'fpToExposedModulePath' sourceDir modPath@.
fpToExposedModulePath :: FilePath -> FilePath -> T.Text
fpToExposedModulePath :: String -> String -> Text
fpToExposedModulePath String
sourceDir String
modPath =
  Text -> [Text] -> Text
T.intercalate Text
"." forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> [String]
FP.splitDirectories forall a b. (a -> b) -> a -> b
$ String -> String
FP.dropExtension String
fp
  where
    fp :: String
fp = forall a. a -> Maybe a -> a
fromMaybe String
modPath forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
sourceDir String
modPath

-- | Takes a path in the exposed module syntax and translates it to a platform-compatible file path.
exposedModulePathToFp :: T.Text -> FilePath
exposedModulePathToFp :: Text -> String
exposedModulePathToFp Text
fp = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"." (Char -> Text
T.singleton Char
FP.pathSeparator) Text
fp