This commit is contained in:
Avi Dessauer 2022-10-19 00:12:16 -05:00
parent bcffe98bad
commit a88f56114c

View File

@ -2,29 +2,37 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module Hie.Cabal.Parser module Hie.Cabal.Parser
( Package(..) ( Package (..),
, Component(..) Component (..),
, CompType(..) CompType (..),
, Name Name,
, extractPkgs extractPkgs,
, parsePackage' parsePackage',
) where )
where
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Data.Attoparsec.Text import Data.Attoparsec.Text
import Data.Char import Data.Char
import Data.Foldable (asum) import Data.Foldable (asum)
import Data.Maybe (catMaybes, import Data.Maybe
maybeToList) ( catMaybes,
maybeToList,
)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Distribution.ModuleName (ModuleName, import Distribution.ModuleName
toFilePath) ( ModuleName,
import Distribution.Package (pkgName, toFilePath,
unPackageName) )
import Distribution.PackageDescription (Benchmark (benchmarkBuildInfo, benchmarkInterface, benchmarkName), import Distribution.Package
( pkgName,
unPackageName,
)
import Distribution.PackageDescription
( Benchmark (benchmarkBuildInfo, benchmarkInterface, benchmarkName),
BenchmarkInterface (BenchmarkExeV10), BenchmarkInterface (BenchmarkExeV10),
Executable (buildInfo, exeName, modulePath), Executable (buildInfo, exeName, modulePath),
ForeignLib (foreignLibBuildInfo, foreignLibName), ForeignLib (foreignLibBuildInfo, foreignLibName),
@ -34,7 +42,8 @@ import Distribution.PackageDescription (Benchmark (bench
benchmarkModules, benchmarkModules,
exeModules, exeModules,
explicitLibModules, explicitLibModules,
foreignLibModules) foreignLibModules,
)
import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parsec import Distribution.PackageDescription.Parsec
import Distribution.Types.BuildInfo import Distribution.Types.BuildInfo
@ -46,7 +55,6 @@ import GHC.IO (unsafePerformIO)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>)) import System.FilePath ((<.>), (</>))
type Name = Text type Name = Text
type Path = Text type Path = Text
@ -148,23 +156,25 @@ parsePackage' t = do
Right $ extractPackage pkg Right $ extractPackage pkg
extractPackage :: PackageDescription -> Package extractPackage :: PackageDescription -> Package
extractPackage PackageDescription{..} = Package n cc where extractPackage PackageDescription {..} = Package n cc
where
n = T.pack . unPackageName $ pkgName package n = T.pack . unPackageName $ pkgName package
cc = concat $ cc =
[mkComp Test (unqName $ testName t) (testBuildInfo t) (testExePath t) (testModules t) | t <- testSuites] ++ concat $
[mkComp Bench (unqName $ benchmarkName b) (benchmarkBuildInfo b) (benchmarkExePath b) (benchmarkModules b) | b <- benchmarks] ++ [mkComp Test (unqName $ testName t) (testBuildInfo t) (testExePath t) (testModules t) | t <- testSuites]
[mkComp Exe (unqName $ exeName e) (buildInfo e) [modulePath e] (exeModules e) | e <- executables] ++ ++ [mkComp Bench (unqName $ benchmarkName b) (benchmarkBuildInfo b) (benchmarkExePath b) (benchmarkModules b) | b <- benchmarks]
[mkComp Lib (libName' l) (libBuildInfo l) [] (explicitLibModules l) | l <- maybeToList library ++ subLibraries ] ++ ++ [mkComp Exe (unqName $ exeName e) (buildInfo e) [modulePath e] (exeModules e) | e <- executables]
[mkComp Lib (unqName $ foreignLibName f) (foreignLibBuildInfo f) [] (foreignLibModules f) | f <- foreignLibs] ++ [mkComp Lib (libName' l) (libBuildInfo l) [] (explicitLibModules l) | l <- maybeToList library ++ subLibraries]
++ [mkComp Lib (unqName $ foreignLibName f) (foreignLibBuildInfo f) [] (foreignLibModules f) | f <- foreignLibs]
mkComp :: CompType -> T.Text -> BuildInfo -> [FilePath] -> [ModuleName] -> [Component] mkComp :: CompType -> T.Text -> BuildInfo -> [FilePath] -> [ModuleName] -> [Component]
mkComp typ name bi fps mods = mkComp typ name bi fps mods =
[ Comp typ name (T.pack fp) [ Comp typ name (T.pack fp)
| fp0 <- fps <> concatMap toFilePath' mods | fp0 <- fps <> concatMap toFilePath' mods,
, srcDir <- map getSymbolicPath $ hsSourceDirs bi srcDir <- map getSymbolicPath $ hsSourceDirs bi,
, let fp = srcDir </> fp0 let fp = srcDir </> fp0,
, unsafePerformIO $ doesFileExist fp unsafePerformIO $ doesFileExist fp
] ]
unqName = T.pack . unUnqualComponentName unqName = T.pack . unUnqualComponentName