{-# 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           Data.Maybe                                     (fromMaybe)
import qualified Data.Text                                      as T
import           Distribution.PackageDescription                (GenericPackageDescription)
import           Ide.Logger                                     (Priority (..),
                                                                 Recorder,
                                                                 WithPriority,
                                                                 logWith)
import           Ide.Plugin.Cabal.Completion.Completer.FilePath (listFileCompletions,
                                                                 mkCompletionDirectory)
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                               (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
      [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
$ (Text -> CompletionItem) -> [Text] -> [CompletionItem]
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
      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

-- | 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
  [String] -> (String -> IO [Text]) -> IO [Text]
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'
            pathInfo :: PathCompletionInfo
pathInfo = String -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo String
dir CabalPrefixInfo
modPrefInfo
        [String]
completions <- Recorder (WithPriority Log) -> PathCompletionInfo -> IO [String]
listFileCompletions Recorder (WithPriority Log)
recorder PathCompletionInfo
pathInfo
        [String]
validExposedCompletions <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (PathCompletionInfo -> String -> IO Bool
isValidExposedModulePath PathCompletionInfo
pathInfo) [String]
completions
        let toMatch :: Text
toMatch = PathCompletionInfo -> Text
pathSegment PathCompletionInfo
pathInfo
            scored :: [Scored Text]
scored = Int -> Int -> Text -> [Text] -> [Scored Text]
Fuzzy.simpleFilter
              Int
Fuzzy.defChunkSize
              Int
Fuzzy.defMaxResults
              Text
toMatch
              ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
validExposedCompletions)
        [Scored Text] -> (Scored Text -> IO Text) -> IO [Text]
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 -> String -> IO Text
mkExposedModulePathCompletion PathCompletionInfo
pathInfo (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
compl
              Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
fullFilePath
          )
    )
  where
    prefix :: Text
prefix =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
exposedModulePathToFp (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
        CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo
    -- build completion info relative to the source dir,
    -- we overwrite the prefix written in the cabal file with its translation
    -- to filepath syntax, since it is in exposed module syntax
    modPrefInfo :: CabalPrefixInfo
modPrefInfo = CabalPrefixInfo
prefInfo{completionPrefix=prefix}

    --    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)
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
fileExists Bool -> Bool -> Bool
|| String -> String
FP.takeExtension String
path String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"."
  let exposedPath :: String
exposedPath = String -> String -> String
FP.makeRelative String
"." String
combinedPath
  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall {p}. (Semigroup p, IsString p) => p -> p
addTrailingDot (Text -> Text) -> Text -> Text
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
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [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 ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String]
FP.splitDirectories (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
FP.dropExtension String
fp
  where
    fp :: String
fp = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
modPath (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
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 (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"." (Char -> Text
T.singleton Char
FP.pathSeparator) Text
fp