Avi-D-coder/implicit-hie
1
1
Fork 0
mirror of https://github.com/Avi-D-coder/implicit-hie.git synced 2024-11-26 11:25:24 +03:00
Code Issues Projects Releases Wiki Activity

handle executable modules and filter out non-existing paths

Browse Source
This commit is contained in:
Pepe Iborra 2022-09-16 10:58:58 +01:00
parent 4a0da1c2a4
commit 25cf51837a
1 changed files with 30 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Hie/Cabal/Parser.hs
View File

@ -23,15 +23,15 @@ import Distribution.ModuleName (ModuleName,
toFilePath) toFilePath)
import Distribution.Package (pkgName, import Distribution.Package (pkgName,
unPackageName) unPackageName)
import Distribution.PackageDescription (Benchmark (benchmarkBuildInfo, benchmarkName), import Distribution.PackageDescription (Benchmark (benchmarkBuildInfo, benchmarkName, benchmarkInterface),
Executable (buildInfo, exeName), Executable (buildInfo, exeName, modulePath),
ForeignLib (foreignLibBuildInfo, foreignLibName), ForeignLib (foreignLibBuildInfo, foreignLibName),
Library (libBuildInfo, libName), Library (libBuildInfo, libName),
LibraryName (..), LibraryName (..),
benchmarkModules, benchmarkModules,
exeModules, exeModules,
explicitLibModules, explicitLibModules,
foreignLibModules) foreignLibModules, TestSuiteInterface (TestSuiteExeV10), BenchmarkInterface (BenchmarkExeV10))
import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parsec import Distribution.PackageDescription.Parsec
import Distribution.Types.BuildInfo import Distribution.Types.BuildInfo
@ -39,7 +39,9 @@ import Distribution.Types.PackageDescription
import Distribution.Types.TestSuite import Distribution.Types.TestSuite
import Distribution.Types.UnqualComponentName import Distribution.Types.UnqualComponentName
import Distribution.Utils.Path (getSymbolicPath) import Distribution.Utils.Path (getSymbolicPath)
import System.FilePath ((</>)) import System.FilePath ((</>), (<.>))
import GHC.IO (unsafePerformIO)
import System.Directory (doesFileExist)
type Name = Text type Name = Text
@ -147,20 +149,35 @@ extractPackage PackageDescription{..} = Package n cc where
n = T.pack . unPackageName $ pkgName package n = T.pack . unPackageName $ pkgName package
cc = concat $ cc = concat $
[mkComp Test (unqName $ testName t) (testBuildInfo t) (testModules t) | t <- testSuites] ++ [mkComp Test (unqName $ testName t) (testBuildInfo t) (testExePath t) (testModules t) | t <- testSuites] ++
[mkComp Bench (unqName $ benchmarkName b) (benchmarkBuildInfo b) (benchmarkModules b) | b <- benchmarks] ++ [mkComp Bench (unqName $ benchmarkName b) (benchmarkBuildInfo b) (benchmarkExePath b) (benchmarkModules b) | b <- benchmarks] ++
[mkComp Exe (unqName $ exeName e) (buildInfo e) (exeModules e) | e <- executables] ++ [mkComp Exe (unqName $ exeName e) (buildInfo e) [modulePath e] (exeModules e) | e <- executables] ++
[mkComp Lib (libName' l) (libBuildInfo l) (explicitLibModules l) | l <- maybeToList library ++ subLibraries ] ++ [mkComp Lib (libName' l) (libBuildInfo l) [] (explicitLibModules l) | l <- maybeToList library ++ subLibraries ] ++
[mkComp Lib (unqName $ foreignLibName f) (foreignLibBuildInfo f) (foreignLibModules f) | f <- foreignLibs] [mkComp Lib (unqName $ foreignLibName f) (foreignLibBuildInfo f) [] (foreignLibModules f) | f <- foreignLibs]
mkComp :: CompType -> T.Text -> BuildInfo -> [ModuleName] -> [Component] mkComp :: CompType -> T.Text -> BuildInfo -> [FilePath] -> [ModuleName] -> [Component]
mkComp typ name bi mods = mkComp typ name bi fps mods =
[Comp typ name (T.pack $ srcDir </> m) [Comp typ name (T.pack fp)
| m <- map toFilePath mods | fp0 <- fps <> concatMap toFilePath' mods
, srcDir <- map getSymbolicPath $ hsSourceDirs bi , srcDir <- map getSymbolicPath $ hsSourceDirs bi
, let fp = srcDir </> fp0
, unsafePerformIO $ doesFileExist fp
] ]
unqName = T.pack . unUnqualComponentName unqName = T.pack . unUnqualComponentName
libName' x = case libName x of libName' x = case libName x of
LMainLibName -> "" LMainLibName -> ""
LSubLibName u -> unqName u LSubLibName u -> unqName u
benchmarkExePath :: Benchmark -> [FilePath]
benchmarkExePath b = case benchmarkInterface b of
BenchmarkExeV10 _ f -> [f]
_ -> []
toFilePath' :: ModuleName -> [FilePath]
toFilePath' mod = [ toFilePath mod <.> ext | ext <- ["hs", "lhs"]]
testExePath :: TestSuite -> [FilePath]
testExePath t = case testInterface t of
TestSuiteExeV10 _ fp -> [fp]
_ -> []