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
data PathCompletionInfo = PathCompletionInfo
{ PathCompletionInfo -> Text
pathSegment :: T.Text,
PathCompletionInfo -> FilePath
queryDirectory :: FilePath,
PathCompletionInfo -> FilePath
workingDirectory :: FilePath,
PathCompletionInfo -> Maybe Apostrophe
isStringNotationPath :: Maybe Apostrophe
}
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)
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')
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
sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
Maybe Text
Nothing GenericPackageDescription
gpd =
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
sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
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
sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
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
sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath]
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
extractRelativeDirsFromStanza ::
Maybe StanzaName ->
GenericPackageDescription ->
(GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) ->
(a -> BuildInfo) ->
[FilePath]
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