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

Fmt

Browse Source
This commit is contained in:
Avi Dessauer 2022-10-19 00:12:16 -05:00
parent bcffe98bad
commit a88f56114c
1 changed files with 79 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,51 +1,59 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# 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.Monad
import Data.Attoparsec.Text
import Data.Char
import Data.Foldable (asum)
import Data.Maybe (catMaybes,
maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Distribution.ModuleName (ModuleName,
toFilePath)
import Distribution.Package (pkgName,
unPackageName)
import Distribution.PackageDescription (Benchmark (benchmarkBuildInfo, benchmarkInterface, benchmarkName),
BenchmarkInterface (BenchmarkExeV10),
Executable (buildInfo, exeName, modulePath),
ForeignLib (foreignLibBuildInfo, foreignLibName),
Library (libBuildInfo, libName),
LibraryName (..),
TestSuiteInterface (TestSuiteExeV10),
benchmarkModules,
exeModules,
explicitLibModules,
foreignLibModules)
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parsec
import Distribution.Types.BuildInfo
import Distribution.Types.PackageDescription
import Distribution.Types.TestSuite
import Distribution.Types.UnqualComponentName
import Distribution.Utils.Path (getSymbolicPath)
import GHC.IO (unsafePerformIO)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import Control.Applicative
import Control.Monad
import Data.Attoparsec.Text
import Data.Char
import Data.Foldable (asum)
import Data.Maybe
( catMaybes,
maybeToList,
)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Distribution.ModuleName
( ModuleName,
toFilePath,
)
import Distribution.Package
( pkgName,
unPackageName,
)
import Distribution.PackageDescription
( Benchmark (benchmarkBuildInfo, benchmarkInterface, benchmarkName),
BenchmarkInterface (BenchmarkExeV10),
Executable (buildInfo, exeName, modulePath),
ForeignLib (foreignLibBuildInfo, foreignLibName),
Library (libBuildInfo, libName),
LibraryName (..),
TestSuiteInterface (TestSuiteExeV10),
benchmarkModules,
exeModules,
explicitLibModules,
foreignLibModules,
)
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parsec
import Distribution.Types.BuildInfo
import Distribution.Types.PackageDescription
import Distribution.Types.TestSuite
import Distribution.Types.UnqualComponentName
import Distribution.Utils.Path (getSymbolicPath)
import GHC.IO (unsafePerformIO)
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
type Name = Text type Name = Text
@ -142,45 +150,47 @@ parsePackage' t = do
let bytes = encodeUtf8 t let bytes = encodeUtf8 t
case runParseResult (parseGenericPackageDescription bytes) of case runParseResult (parseGenericPackageDescription bytes) of
(_warnings, Left err) -> (_warnings, Left err) ->
error $ "Cannot parse Cabal file: " <> show err error $ "Cannot parse Cabal file: " <> show err
(_warnings, Right res) -> do (_warnings, Right res) -> do
let pkg = flattenPackageDescription res let pkg = flattenPackageDescription res
Right $ extractPackage pkg Right $ extractPackage pkg
extractPackage :: PackageDescription -> Package extractPackage :: PackageDescription -> Package
extractPackage PackageDescription{..} = Package n cc where extractPackage PackageDescription {..} = Package n cc
n = T.pack . unPackageName $ pkgName package where
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
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 :: Benchmark -> [FilePath]
benchmarkExePath b = case benchmarkInterface b of benchmarkExePath b = case benchmarkInterface b of
BenchmarkExeV10 _ f -> [f] BenchmarkExeV10 _ f -> [f]
_ -> [] _ -> []
toFilePath' :: ModuleName -> [FilePath] toFilePath' :: ModuleName -> [FilePath]
toFilePath' mod = [ toFilePath mod <.> ext | ext <- ["hs", "lhs"]] toFilePath' mod = [toFilePath mod <.> ext | ext <- ["hs", "lhs"]]
testExePath :: TestSuite -> [FilePath] testExePath :: TestSuite -> [FilePath]
testExePath t = case testInterface t of testExePath t = case testInterface t of
TestSuiteExeV10 _ fp -> [fp] TestSuiteExeV10 _ fp -> [fp]
_ -> [] _ -> []