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

import qualified Data.List                         as List
import           Data.List.Extra                   (dropPrefix)
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.Plugin.Cabal.Completion.Types
import qualified System.FilePath                   as FP
import qualified System.FilePath.Posix             as Posix


{- | 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
  { PathCompletionInfo -> Text
pathSegment          :: T.Text,
    -- ^ Partly written segment of the next part of the path.
    PathCompletionInfo -> FilePath
queryDirectory       :: FilePath,
    -- ^ Written part of path, in posix format.
    PathCompletionInfo -> FilePath
workingDirectory     :: FilePath,
    -- ^ Directory relative to which relative paths are interpreted, platform dependent.
    PathCompletionInfo -> Maybe Apostrophe
isStringNotationPath :: Maybe Apostrophe
    -- ^ Did the completion happen in the context of a string notation,
    -- if yes, contains the state of the string notation.
  }
  deriving (PathCompletionInfo -> PathCompletionInfo -> Bool
(PathCompletionInfo -> PathCompletionInfo -> Bool)
-> (PathCompletionInfo -> PathCompletionInfo -> Bool)
-> Eq PathCompletionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathCompletionInfo -> PathCompletionInfo -> Bool
== :: PathCompletionInfo -> PathCompletionInfo -> Bool
$c/= :: PathCompletionInfo -> PathCompletionInfo -> Bool
/= :: PathCompletionInfo -> PathCompletionInfo -> Bool
Eq, Int -> PathCompletionInfo -> ShowS
[PathCompletionInfo] -> ShowS
PathCompletionInfo -> FilePath
(Int -> PathCompletionInfo -> ShowS)
-> (PathCompletionInfo -> FilePath)
-> ([PathCompletionInfo] -> ShowS)
-> Show PathCompletionInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathCompletionInfo -> ShowS
showsPrec :: Int -> PathCompletionInfo -> ShowS
$cshow :: PathCompletionInfo -> FilePath
show :: PathCompletionInfo -> FilePath
$cshowList :: [PathCompletionInfo] -> ShowS
showList :: [PathCompletionInfo] -> ShowS
Show)


{- | Posix.splitFileName modification, that drops trailing ./ if
  if wasn't present in the original path.

  Fix for the issue #3774
  Examples:

  >>> splitFileNameNoTrailingSlash ""
  ("", "")
  >>> splitFileNameNoTrailingSlash "./"
  ("./", "")
  >>> splitFileNameNoTrailingSlash "dir"
  ("", "dir")
  >>> splitFileNameNoTrailingSlash "./dir"
  ("./", "dir")
  >>> splitFileNameNoTrailingSlash "dir1/dir2"
  ("dir1/","dir2")
  >>> splitFileNameNoTrailingSlash "./dir1/dir2"
  ("./dir1/","dir2")
-}
splitFileNameNoTrailingSlash :: FilePath -> (String, String)
splitFileNameNoTrailingSlash :: FilePath -> (FilePath, FilePath)
splitFileNameNoTrailingSlash FilePath
prefix = Bool -> (FilePath, FilePath) -> (FilePath, FilePath)
forall {b}. Bool -> (FilePath, b) -> (FilePath, b)
rmTrailingSlash (FilePath
"./" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` FilePath
prefix) (FilePath -> (FilePath, FilePath)
Posix.splitFileName FilePath
prefix)
  where rmTrailingSlash :: Bool -> (FilePath, b) -> (FilePath, b)
rmTrailingSlash Bool
hadTrailingSlash (FilePath
queryDirectory', b
pathSegment')
                    | Bool
hadTrailingSlash = (FilePath
queryDirectory', b
pathSegment')
                    | Bool
otherwise        = (FilePath
"./" FilePath -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
`dropPrefix` FilePath
queryDirectory', b
pathSegment')

{- | Takes an optional source subdirectory and a prefix info
  and creates a path completion info accordingly.

  The source directory represents some subdirectory of the working directory such as a
  path from the field @hs-source-dirs@.

  If the source subdirectory is empty, then the working directory is simply set to
  the currently handled cabal file's directory.
-}
pathCompletionInfoFromCabalPrefixInfo :: FilePath -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo :: FilePath -> CabalPrefixInfo -> PathCompletionInfo
pathCompletionInfoFromCabalPrefixInfo FilePath
srcDir CabalPrefixInfo
prefInfo =
  PathCompletionInfo
    { pathSegment :: Text
pathSegment = FilePath -> Text
T.pack FilePath
pathSegment',
      queryDirectory :: FilePath
queryDirectory = FilePath
queryDirectory',
      workingDirectory :: FilePath
workingDirectory = CabalPrefixInfo -> FilePath
completionWorkingDir CabalPrefixInfo
prefInfo FilePath -> ShowS
FP.</> FilePath
srcDir,
      isStringNotationPath :: Maybe Apostrophe
isStringNotationPath = CabalPrefixInfo -> Maybe Apostrophe
isStringNotation CabalPrefixInfo
prefInfo
    }
  where
    prefix :: FilePath
prefix = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ CabalPrefixInfo -> Text
completionPrefix CabalPrefixInfo
prefInfo
    (FilePath
queryDirectory', FilePath
pathSegment') = FilePath -> (FilePath, FilePath)
splitFileNameNoTrailingSlash FilePath
prefix

-- | Extracts the source directories of the library stanza.
sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
sourceDirsExtractionLibrary :: Maybe Text -> GenericPackageDescription -> [FilePath]
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
      (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo -> [SymbolicPath PackageDir SourceDir]
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo (Library -> BuildInfo) -> Library -> BuildInfo
forall a b. (a -> b) -> a -> b
$ CondTree ConfVar [Dependency] Library -> Library
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 = Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> (Library -> BuildInfo)
-> [FilePath]
forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [FilePath]
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 -> [FilePath]
sourceDirsExtractionExecutable Maybe Text
name GenericPackageDescription
gpd = Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> (Executable -> BuildInfo)
-> [FilePath]
forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [FilePath]
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 -> [FilePath]
sourceDirsExtractionTestSuite Maybe Text
name GenericPackageDescription
gpd = Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] TestSuite)])
-> (TestSuite -> BuildInfo)
-> [FilePath]
forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [FilePath]
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 -> [FilePath]
sourceDirsExtractionBenchmark Maybe Text
name GenericPackageDescription
gpd = Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Benchmark)])
-> (Benchmark -> BuildInfo)
-> [FilePath]
forall b c a.
Maybe Text
-> GenericPackageDescription
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree b c a)])
-> (a -> BuildInfo)
-> [FilePath]
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)
-> [FilePath]
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 = (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo -> [SymbolicPath PackageDir SourceDir]
forall a b. (a -> b) -> a -> b
$ a -> BuildInfo
getBuildInfo a
stanza
  | Bool
otherwise = []
  where
    stanzaM :: Maybe a
stanzaM = ((UnqualComponentName, CondTree b c a) -> a)
-> Maybe (UnqualComponentName, CondTree b c a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CondTree b c a -> a
forall v c a. CondTree v c a -> a
condTreeData (CondTree b c a -> a)
-> ((UnqualComponentName, CondTree b c a) -> CondTree b c a)
-> (UnqualComponentName, CondTree b c a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree b c a) -> CondTree b c a
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 =
      ((UnqualComponentName, CondTree b c a) -> Bool)
-> [(UnqualComponentName, CondTree b c a)]
-> Maybe (UnqualComponentName, CondTree b c a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
        ( \(UnqualComponentName
n, CondTree b c a
_) ->
            UnqualComponentName
n UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> UnqualComponentName
mkUnqualComponentName (Text -> FilePath
T.unpack Text
name)
        )
        [(UnqualComponentName, CondTree b c a)]
allStanzasM