{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Ormolu.Utils.Cabal
( CabalSearchResult (..),
CabalInfo (..),
Extension (..),
getCabalInfoForSourceFile,
findCabalFile,
parseCabalInfo,
)
where
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import Data.IORef
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe (maybeToList)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec
import qualified Distribution.Types.CondTree as CT
import Distribution.Utils.Path (getSymbolicPath)
import Language.Haskell.Extension
import Ormolu.Config
import Ormolu.Exception
import System.Directory
import System.FilePath
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
data CabalSearchResult
=
CabalNotFound
|
CabalDidNotMention CabalInfo
|
CabalFound CabalInfo
deriving (CabalSearchResult -> CabalSearchResult -> Bool
(CabalSearchResult -> CabalSearchResult -> Bool)
-> (CabalSearchResult -> CabalSearchResult -> Bool)
-> Eq CabalSearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalSearchResult -> CabalSearchResult -> Bool
== :: CabalSearchResult -> CabalSearchResult -> Bool
$c/= :: CabalSearchResult -> CabalSearchResult -> Bool
/= :: CabalSearchResult -> CabalSearchResult -> Bool
Eq, Int -> CabalSearchResult -> ShowS
[CabalSearchResult] -> ShowS
CabalSearchResult -> FilePath
(Int -> CabalSearchResult -> ShowS)
-> (CabalSearchResult -> FilePath)
-> ([CabalSearchResult] -> ShowS)
-> Show CabalSearchResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalSearchResult -> ShowS
showsPrec :: Int -> CabalSearchResult -> ShowS
$cshow :: CabalSearchResult -> FilePath
show :: CabalSearchResult -> FilePath
$cshowList :: [CabalSearchResult] -> ShowS
showList :: [CabalSearchResult] -> ShowS
Show)
data CabalInfo = CabalInfo
{
CabalInfo -> PackageName
ciPackageName :: !PackageName,
CabalInfo -> [DynOption]
ciDynOpts :: ![DynOption],
CabalInfo -> Set PackageName
ciDependencies :: !(Set PackageName),
CabalInfo -> FilePath
ciCabalFilePath :: !FilePath
}
deriving (CabalInfo -> CabalInfo -> Bool
(CabalInfo -> CabalInfo -> Bool)
-> (CabalInfo -> CabalInfo -> Bool) -> Eq CabalInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalInfo -> CabalInfo -> Bool
== :: CabalInfo -> CabalInfo -> Bool
$c/= :: CabalInfo -> CabalInfo -> Bool
/= :: CabalInfo -> CabalInfo -> Bool
Eq, Int -> CabalInfo -> ShowS
[CabalInfo] -> ShowS
CabalInfo -> FilePath
(Int -> CabalInfo -> ShowS)
-> (CabalInfo -> FilePath)
-> ([CabalInfo] -> ShowS)
-> Show CabalInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalInfo -> ShowS
showsPrec :: Int -> CabalInfo -> ShowS
$cshow :: CabalInfo -> FilePath
show :: CabalInfo -> FilePath
$cshowList :: [CabalInfo] -> ShowS
showList :: [CabalInfo] -> ShowS
Show)
getCabalInfoForSourceFile ::
(MonadIO m) =>
FilePath ->
m CabalSearchResult
getCabalInfoForSourceFile :: forall (m :: * -> *). MonadIO m => FilePath -> m CabalSearchResult
getCabalInfoForSourceFile FilePath
sourceFile = IO CabalSearchResult -> m CabalSearchResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CabalSearchResult -> m CabalSearchResult)
-> IO CabalSearchResult -> m CabalSearchResult
forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findCabalFile FilePath
sourceFile IO (Maybe FilePath)
-> (Maybe FilePath -> IO CabalSearchResult) -> IO CabalSearchResult
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
cabalFile -> do
(Bool
mentioned, CabalInfo
cabalInfo) <- FilePath -> FilePath -> IO (Bool, CabalInfo)
forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> m (Bool, CabalInfo)
parseCabalInfo FilePath
cabalFile FilePath
sourceFile
CabalSearchResult -> IO CabalSearchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
( if Bool
mentioned
then CabalInfo -> CabalSearchResult
CabalFound CabalInfo
cabalInfo
else CabalInfo -> CabalSearchResult
CabalDidNotMention CabalInfo
cabalInfo
)
Maybe FilePath
Nothing -> CabalSearchResult -> IO CabalSearchResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CabalSearchResult
CabalNotFound
findCabalFile ::
(MonadIO m) =>
FilePath ->
m (Maybe FilePath)
findCabalFile :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findCabalFile FilePath
sourceFile = IO (Maybe FilePath) -> m (Maybe FilePath)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath) -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
FilePath
parentDir <- ShowS
takeDirectory ShowS -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
makeAbsolute FilePath
sourceFile
[FilePath]
dirEntries <-
FilePath -> IO [FilePath]
listDirectory FilePath
parentDir IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \case
(IOError -> Bool
isDoesNotExistError -> Bool
True) -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
IOError
e -> IOError -> IO [FilePath]
forall e a. Exception e => e -> IO a
throwIO IOError
e
let findDotCabal :: [FilePath] -> IO (Maybe FilePath)
findDotCabal = \case
[] -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
FilePath
e : [FilePath]
es
| ShowS
takeExtension FilePath
e FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal" ->
FilePath -> IO Bool
doesFileExist (FilePath
parentDir FilePath -> ShowS
</> FilePath
e) IO Bool -> (Bool -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
e
Bool
False -> [FilePath] -> IO (Maybe FilePath)
findDotCabal [FilePath]
es
FilePath
_ : [FilePath]
es -> [FilePath] -> IO (Maybe FilePath)
findDotCabal [FilePath]
es
[FilePath] -> IO (Maybe FilePath)
findDotCabal [FilePath]
dirEntries IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
cabalFile -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
parentDir FilePath -> ShowS
</> FilePath
cabalFile
Maybe FilePath
Nothing ->
if FilePath -> Bool
isDrive FilePath
parentDir
then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
findCabalFile FilePath
parentDir
data CachedCabalFile = CachedCabalFile
{
CachedCabalFile -> GenericPackageDescription
genericPackageDescription :: GenericPackageDescription,
CachedCabalFile -> Map FilePath ([DynOption], [PackageName])
extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
}
deriving (Int -> CachedCabalFile -> ShowS
[CachedCabalFile] -> ShowS
CachedCabalFile -> FilePath
(Int -> CachedCabalFile -> ShowS)
-> (CachedCabalFile -> FilePath)
-> ([CachedCabalFile] -> ShowS)
-> Show CachedCabalFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachedCabalFile -> ShowS
showsPrec :: Int -> CachedCabalFile -> ShowS
$cshow :: CachedCabalFile -> FilePath
show :: CachedCabalFile -> FilePath
$cshowList :: [CachedCabalFile] -> ShowS
showList :: [CachedCabalFile] -> ShowS
Show)
cabalCacheRef :: IORef (Map FilePath CachedCabalFile)
cabalCacheRef :: IORef (Map FilePath CachedCabalFile)
cabalCacheRef = IO (IORef (Map FilePath CachedCabalFile))
-> IORef (Map FilePath CachedCabalFile)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map FilePath CachedCabalFile))
-> IORef (Map FilePath CachedCabalFile))
-> IO (IORef (Map FilePath CachedCabalFile))
-> IORef (Map FilePath CachedCabalFile)
forall a b. (a -> b) -> a -> b
$ Map FilePath CachedCabalFile
-> IO (IORef (Map FilePath CachedCabalFile))
forall a. a -> IO (IORef a)
newIORef Map FilePath CachedCabalFile
forall k a. Map k a
M.empty
{-# NOINLINE cabalCacheRef #-}
parseCabalInfo ::
(MonadIO m) =>
FilePath ->
FilePath ->
m (Bool, CabalInfo)
parseCabalInfo :: forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> m (Bool, CabalInfo)
parseCabalInfo FilePath
cabalFileAsGiven FilePath
sourceFileAsGiven = IO (Bool, CabalInfo) -> m (Bool, CabalInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CabalInfo) -> m (Bool, CabalInfo))
-> IO (Bool, CabalInfo) -> m (Bool, CabalInfo)
forall a b. (a -> b) -> a -> b
$ do
FilePath
cabalFile <- FilePath -> IO FilePath
makeAbsolute FilePath
cabalFileAsGiven
FilePath
sourceFileAbs <- FilePath -> IO FilePath
makeAbsolute FilePath
sourceFileAsGiven
Map FilePath CachedCabalFile
cabalCache <- IORef (Map FilePath CachedCabalFile)
-> IO (Map FilePath CachedCabalFile)
forall a. IORef a -> IO a
readIORef IORef (Map FilePath CachedCabalFile)
cabalCacheRef
CachedCabalFile {Map FilePath ([DynOption], [PackageName])
GenericPackageDescription
genericPackageDescription :: CachedCabalFile -> GenericPackageDescription
extensionsAndDeps :: CachedCabalFile -> Map FilePath ([DynOption], [PackageName])
genericPackageDescription :: GenericPackageDescription
extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
..} <- Maybe CachedCabalFile -> IO CachedCabalFile -> IO CachedCabalFile
forall (m :: * -> *) a. Monad m => Maybe a -> m a -> m a
whenNothing (FilePath -> Map FilePath CachedCabalFile -> Maybe CachedCabalFile
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
cabalFile Map FilePath CachedCabalFile
cabalCache) (IO CachedCabalFile -> IO CachedCabalFile)
-> IO CachedCabalFile -> IO CachedCabalFile
forall a b. (a -> b) -> a -> b
$ do
ByteString
cabalFileBs <- FilePath -> IO ByteString
B.readFile FilePath
cabalFile
GenericPackageDescription
genericPackageDescription <-
Maybe GenericPackageDescription
-> IO GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *) a. Monad m => Maybe a -> m a -> m a
whenNothing (ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
cabalFileBs) (IO GenericPackageDescription -> IO GenericPackageDescription)
-> IO GenericPackageDescription -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$
OrmoluException -> IO GenericPackageDescription
forall e a. Exception e => e -> IO a
throwIO (FilePath -> OrmoluException
OrmoluCabalFileParsingFailed FilePath
cabalFile)
let extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
extensionsAndDeps =
FilePath
-> GenericPackageDescription
-> Map FilePath ([DynOption], [PackageName])
getExtensionAndDepsMap FilePath
cabalFile GenericPackageDescription
genericPackageDescription
cachedCabalFile :: CachedCabalFile
cachedCabalFile = CachedCabalFile {Map FilePath ([DynOption], [PackageName])
GenericPackageDescription
genericPackageDescription :: GenericPackageDescription
extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
genericPackageDescription :: GenericPackageDescription
extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
..}
IORef (Map FilePath CachedCabalFile)
-> (Map FilePath CachedCabalFile
-> (Map FilePath CachedCabalFile, CachedCabalFile))
-> IO CachedCabalFile
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Map FilePath CachedCabalFile)
cabalCacheRef ((Map FilePath CachedCabalFile
-> (Map FilePath CachedCabalFile, CachedCabalFile))
-> IO CachedCabalFile)
-> (Map FilePath CachedCabalFile
-> (Map FilePath CachedCabalFile, CachedCabalFile))
-> IO CachedCabalFile
forall a b. (a -> b) -> a -> b
$
(,CachedCabalFile
cachedCabalFile) (Map FilePath CachedCabalFile
-> (Map FilePath CachedCabalFile, CachedCabalFile))
-> (Map FilePath CachedCabalFile -> Map FilePath CachedCabalFile)
-> Map FilePath CachedCabalFile
-> (Map FilePath CachedCabalFile, CachedCabalFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> CachedCabalFile
-> Map FilePath CachedCabalFile
-> Map FilePath CachedCabalFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
cabalFile CachedCabalFile
cachedCabalFile
let ([DynOption]
dynOpts, [PackageName]
dependencies, Bool
mentioned) =
case FilePath
-> Map FilePath ([DynOption], [PackageName])
-> Maybe ([DynOption], [PackageName])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ShowS
dropExtensions FilePath
sourceFileAbs) Map FilePath ([DynOption], [PackageName])
extensionsAndDeps of
Maybe ([DynOption], [PackageName])
Nothing -> ([], [], Bool
False)
Just ([DynOption]
dynOpts', [PackageName]
dependencies') -> ([DynOption]
dynOpts', [PackageName]
dependencies', Bool
True)
pdesc :: PackageDescription
pdesc = GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
genericPackageDescription
(Bool, CabalInfo) -> IO (Bool, CabalInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Bool
mentioned,
CabalInfo
{ ciPackageName :: PackageName
ciPackageName = PackageIdentifier -> PackageName
pkgName (PackageDescription -> PackageIdentifier
package PackageDescription
pdesc),
ciDynOpts :: [DynOption]
ciDynOpts = [DynOption]
dynOpts,
ciDependencies :: Set PackageName
ciDependencies = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
Set.fromList [PackageName]
dependencies,
ciCabalFilePath :: FilePath
ciCabalFilePath = FilePath
cabalFile
}
)
where
whenNothing :: (Monad m) => Maybe a -> m a -> m a
whenNothing :: forall (m :: * -> *) a. Monad m => Maybe a -> m a -> m a
whenNothing Maybe a
maya m a
ma = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
ma a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
maya
getExtensionAndDepsMap ::
FilePath ->
GenericPackageDescription ->
Map FilePath ([DynOption], [PackageName])
getExtensionAndDepsMap :: FilePath
-> GenericPackageDescription
-> Map FilePath ([DynOption], [PackageName])
getExtensionAndDepsMap FilePath
cabalFile GenericPackageDescription {[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
[PackageFlag]
Maybe (CondTree ConfVar [Dependency] Library)
Maybe Version
PackageDescription
packageDescription :: GenericPackageDescription -> PackageDescription
packageDescription :: PackageDescription
gpdScannedVersion :: Maybe Version
genPackageFlags :: [PackageFlag]
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
gpdScannedVersion :: GenericPackageDescription -> Maybe Version
genPackageFlags :: GenericPackageDescription -> [PackageFlag]
condLibrary :: GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condTestSuites :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
..} =
[Map FilePath ([DynOption], [PackageName])]
-> Map FilePath ([DynOption], [PackageName])
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map FilePath ([DynOption], [PackageName])]
-> Map FilePath ([DynOption], [PackageName]))
-> ([[Map FilePath ([DynOption], [PackageName])]]
-> [Map FilePath ([DynOption], [PackageName])])
-> [[Map FilePath ([DynOption], [PackageName])]]
-> Map FilePath ([DynOption], [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Map FilePath ([DynOption], [PackageName])]]
-> [Map FilePath ([DynOption], [PackageName])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Map FilePath ([DynOption], [PackageName])]]
-> Map FilePath ([DynOption], [PackageName]))
-> [[Map FilePath ([DynOption], [PackageName])]]
-> Map FilePath ([DynOption], [PackageName])
forall a b. (a -> b) -> a -> b
$
[ (Library -> ([FilePath], ([DynOption], [PackageName])))
-> CondTree ConfVar [Dependency] Library
-> Map FilePath ([DynOption], [PackageName])
forall {k} {a} {c} {a} {v}.
(Ord k, Semigroup a, Semigroup c) =>
(a -> ([k], a)) -> CondTree v c a -> Map k a
buildMap Library -> ([FilePath], ([DynOption], [PackageName]))
extractFromLibrary (CondTree ConfVar [Dependency] Library
-> Map FilePath ([DynOption], [PackageName]))
-> [CondTree ConfVar [Dependency] Library]
-> [Map FilePath ([DynOption], [PackageName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CondTree ConfVar [Dependency] Library]
lib [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
forall a. [a] -> [a] -> [a]
++ [CondTree ConfVar [Dependency] Library]
sublibs,
(Executable -> ([FilePath], ([DynOption], [PackageName])))
-> CondTree ConfVar [Dependency] Executable
-> Map FilePath ([DynOption], [PackageName])
forall {k} {a} {c} {a} {v}.
(Ord k, Semigroup a, Semigroup c) =>
(a -> ([k], a)) -> CondTree v c a -> Map k a
buildMap Executable -> ([FilePath], ([DynOption], [PackageName]))
extractFromExecutable (CondTree ConfVar [Dependency] Executable
-> Map FilePath ([DynOption], [PackageName]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Map FilePath ([DynOption], [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Map FilePath ([DynOption], [PackageName]))
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [Map FilePath ([DynOption], [PackageName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables,
(TestSuite -> ([FilePath], ([DynOption], [PackageName])))
-> CondTree ConfVar [Dependency] TestSuite
-> Map FilePath ([DynOption], [PackageName])
forall {k} {a} {c} {a} {v}.
(Ord k, Semigroup a, Semigroup c) =>
(a -> ([k], a)) -> CondTree v c a -> Map k a
buildMap TestSuite -> ([FilePath], ([DynOption], [PackageName]))
extractFromTestSuite (CondTree ConfVar [Dependency] TestSuite
-> Map FilePath ([DynOption], [PackageName]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Map FilePath ([DynOption], [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Map FilePath ([DynOption], [PackageName]))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Map FilePath ([DynOption], [PackageName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites,
(Benchmark -> ([FilePath], ([DynOption], [PackageName])))
-> CondTree ConfVar [Dependency] Benchmark
-> Map FilePath ([DynOption], [PackageName])
forall {k} {a} {c} {a} {v}.
(Ord k, Semigroup a, Semigroup c) =>
(a -> ([k], a)) -> CondTree v c a -> Map k a
buildMap Benchmark -> ([FilePath], ([DynOption], [PackageName]))
extractFromBenchmark (CondTree ConfVar [Dependency] Benchmark
-> Map FilePath ([DynOption], [PackageName]))
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Map FilePath ([DynOption], [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Map FilePath ([DynOption], [PackageName]))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Map FilePath ([DynOption], [PackageName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
]
where
lib :: [CondTree ConfVar [Dependency] Library]
lib = Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
sublibs :: [CondTree ConfVar [Dependency] Library]
sublibs = (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
buildMap :: (a -> ([k], a)) -> CondTree v c a -> Map k a
buildMap a -> ([k], a)
f CondTree v c a
a = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((,a
extsAndDeps) (k -> (k, a)) -> [k] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k]
files)
where
(a
mergedA, c
_) = CondTree v c a -> (a, c)
forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
CT.ignoreConditions CondTree v c a
a
([k]
files, a
extsAndDeps) = a -> ([k], a)
f a
mergedA
extractFromBuildInfo :: [FilePath]
-> BuildInfo -> ([FilePath], ([DynOption], [PackageName]))
extractFromBuildInfo [FilePath]
extraModules BuildInfo {Bool
[FilePath]
[(FilePath, FilePath)]
[SymbolicPath PackageDir SourceDir]
[PkgconfigDependency]
[ModuleName]
[Mixin]
[LegacyExeDependency]
[ExeDependency]
[Dependency]
[Extension]
[Language]
Maybe Language
PerCompilerFlavor [FilePath]
buildable :: Bool
buildTools :: [LegacyExeDependency]
buildToolDepends :: [ExeDependency]
cppOptions :: [FilePath]
asmOptions :: [FilePath]
cmmOptions :: [FilePath]
ccOptions :: [FilePath]
cxxOptions :: [FilePath]
ldOptions :: [FilePath]
hsc2hsOptions :: [FilePath]
pkgconfigDepends :: [PkgconfigDependency]
frameworks :: [FilePath]
extraFrameworkDirs :: [FilePath]
asmSources :: [FilePath]
cmmSources :: [FilePath]
cSources :: [FilePath]
cxxSources :: [FilePath]
jsSources :: [FilePath]
hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
otherModules :: [ModuleName]
virtualModules :: [ModuleName]
autogenModules :: [ModuleName]
defaultLanguage :: Maybe Language
otherLanguages :: [Language]
defaultExtensions :: [Extension]
otherExtensions :: [Extension]
oldExtensions :: [Extension]
extraLibs :: [FilePath]
extraLibsStatic :: [FilePath]
extraGHCiLibs :: [FilePath]
extraBundledLibs :: [FilePath]
extraLibFlavours :: [FilePath]
extraDynLibFlavours :: [FilePath]
extraLibDirs :: [FilePath]
extraLibDirsStatic :: [FilePath]
includeDirs :: [FilePath]
includes :: [FilePath]
autogenIncludes :: [FilePath]
installIncludes :: [FilePath]
options :: PerCompilerFlavor [FilePath]
profOptions :: PerCompilerFlavor [FilePath]
sharedOptions :: PerCompilerFlavor [FilePath]
staticOptions :: PerCompilerFlavor [FilePath]
customFieldsBI :: [(FilePath, FilePath)]
targetBuildDepends :: [Dependency]
mixins :: [Mixin]
buildable :: BuildInfo -> Bool
buildTools :: BuildInfo -> [LegacyExeDependency]
buildToolDepends :: BuildInfo -> [ExeDependency]
cppOptions :: BuildInfo -> [FilePath]
asmOptions :: BuildInfo -> [FilePath]
cmmOptions :: BuildInfo -> [FilePath]
ccOptions :: BuildInfo -> [FilePath]
cxxOptions :: BuildInfo -> [FilePath]
ldOptions :: BuildInfo -> [FilePath]
hsc2hsOptions :: BuildInfo -> [FilePath]
pkgconfigDepends :: BuildInfo -> [PkgconfigDependency]
frameworks :: BuildInfo -> [FilePath]
extraFrameworkDirs :: BuildInfo -> [FilePath]
asmSources :: BuildInfo -> [FilePath]
cmmSources :: BuildInfo -> [FilePath]
cSources :: BuildInfo -> [FilePath]
cxxSources :: BuildInfo -> [FilePath]
jsSources :: BuildInfo -> [FilePath]
hsSourceDirs :: BuildInfo -> [SymbolicPath PackageDir SourceDir]
otherModules :: BuildInfo -> [ModuleName]
virtualModules :: BuildInfo -> [ModuleName]
autogenModules :: BuildInfo -> [ModuleName]
defaultLanguage :: BuildInfo -> Maybe Language
otherLanguages :: BuildInfo -> [Language]
defaultExtensions :: BuildInfo -> [Extension]
otherExtensions :: BuildInfo -> [Extension]
oldExtensions :: BuildInfo -> [Extension]
extraLibs :: BuildInfo -> [FilePath]
extraLibsStatic :: BuildInfo -> [FilePath]
extraGHCiLibs :: BuildInfo -> [FilePath]
extraBundledLibs :: BuildInfo -> [FilePath]
extraLibFlavours :: BuildInfo -> [FilePath]
extraDynLibFlavours :: BuildInfo -> [FilePath]
extraLibDirs :: BuildInfo -> [FilePath]
extraLibDirsStatic :: BuildInfo -> [FilePath]
includeDirs :: BuildInfo -> [FilePath]
includes :: BuildInfo -> [FilePath]
autogenIncludes :: BuildInfo -> [FilePath]
installIncludes :: BuildInfo -> [FilePath]
options :: BuildInfo -> PerCompilerFlavor [FilePath]
profOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
sharedOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
staticOptions :: BuildInfo -> PerCompilerFlavor [FilePath]
customFieldsBI :: BuildInfo -> [(FilePath, FilePath)]
targetBuildDepends :: BuildInfo -> [Dependency]
mixins :: BuildInfo -> [Mixin]
..} = (,([DynOption]
exts, [PackageName]
deps)) ([FilePath] -> ([FilePath], ([DynOption], [PackageName])))
-> [FilePath] -> ([FilePath], ([DynOption], [PackageName]))
forall a b. (a -> b) -> a -> b
$ do
FilePath
m <- [FilePath]
extraModules [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> FilePath
ModuleName.toFilePath (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
otherModules)
ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS
takeDirectory FilePath
cabalFile FilePath -> ShowS
</>) ShowS -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath]
prependSrcDirs (ShowS
dropExtensions FilePath
m)
where
prependSrcDirs :: FilePath -> [FilePath]
prependSrcDirs FilePath
f
| [SymbolicPath PackageDir SourceDir] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicPath PackageDir SourceDir]
hsSourceDirs = [FilePath
f]
| Bool
otherwise = (FilePath -> ShowS
</> FilePath
f) ShowS
-> (SymbolicPath PackageDir SourceDir -> FilePath)
-> SymbolicPath PackageDir SourceDir
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolicPath PackageDir SourceDir]
hsSourceDirs
deps :: [PackageName]
deps = Dependency -> PackageName
depPkgName (Dependency -> PackageName) -> [Dependency] -> [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dependency]
targetBuildDepends
exts :: [DynOption]
exts = [DynOption]
-> (Language -> [DynOption]) -> Maybe Language -> [DynOption]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Language -> [DynOption]
langExt Maybe Language
defaultLanguage [DynOption] -> [DynOption] -> [DynOption]
forall a. [a] -> [a] -> [a]
++ (Extension -> DynOption) -> [Extension] -> [DynOption]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> DynOption
extToDynOption [Extension]
defaultExtensions
langExt :: Language -> [DynOption]
langExt =
DynOption -> [DynOption]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynOption -> [DynOption])
-> (Language -> DynOption) -> Language -> [DynOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DynOption
DynOption (FilePath -> DynOption)
-> (Language -> FilePath) -> Language -> DynOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"-X" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Language -> FilePath) -> Language -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
UnknownLanguage FilePath
lan -> FilePath
lan
Language
lan -> Language -> FilePath
forall a. Show a => a -> FilePath
show Language
lan
extToDynOption :: Extension -> DynOption
extToDynOption =
FilePath -> DynOption
DynOption (FilePath -> DynOption)
-> (Extension -> FilePath) -> Extension -> DynOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
EnableExtension KnownExtension
e -> FilePath
"-X" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ KnownExtension -> FilePath
forall a. Show a => a -> FilePath
show KnownExtension
e
DisableExtension KnownExtension
e -> FilePath
"-XNo" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ KnownExtension -> FilePath
forall a. Show a => a -> FilePath
show KnownExtension
e
UnknownExtension FilePath
e -> FilePath
"-X" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
e
extractFromLibrary :: Library -> ([FilePath], ([DynOption], [PackageName]))
extractFromLibrary Library {Bool
[ModuleName]
[ModuleReexport]
LibraryVisibility
LibraryName
BuildInfo
libName :: LibraryName
exposedModules :: [ModuleName]
reexportedModules :: [ModuleReexport]
signatures :: [ModuleName]
libExposed :: Bool
libVisibility :: LibraryVisibility
libBuildInfo :: BuildInfo
libName :: Library -> LibraryName
exposedModules :: Library -> [ModuleName]
reexportedModules :: Library -> [ModuleReexport]
signatures :: Library -> [ModuleName]
libExposed :: Library -> Bool
libVisibility :: Library -> LibraryVisibility
libBuildInfo :: Library -> BuildInfo
..} =
[FilePath]
-> BuildInfo -> ([FilePath], ([DynOption], [PackageName]))
extractFromBuildInfo (ModuleName -> FilePath
ModuleName.toFilePath (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleName]
exposedModules) BuildInfo
libBuildInfo
extractFromExecutable :: Executable -> ([FilePath], ([DynOption], [PackageName]))
extractFromExecutable Executable {FilePath
UnqualComponentName
ExecutableScope
BuildInfo
exeName :: UnqualComponentName
modulePath :: FilePath
exeScope :: ExecutableScope
buildInfo :: BuildInfo
exeName :: Executable -> UnqualComponentName
modulePath :: Executable -> FilePath
exeScope :: Executable -> ExecutableScope
buildInfo :: Executable -> BuildInfo
..} =
[FilePath]
-> BuildInfo -> ([FilePath], ([DynOption], [PackageName]))
extractFromBuildInfo [FilePath
modulePath] BuildInfo
buildInfo
extractFromTestSuite :: TestSuite -> ([FilePath], ([DynOption], [PackageName]))
extractFromTestSuite TestSuite {[FilePath]
UnqualComponentName
TestSuiteInterface
BuildInfo
testName :: UnqualComponentName
testInterface :: TestSuiteInterface
testBuildInfo :: BuildInfo
testCodeGenerators :: [FilePath]
testName :: TestSuite -> UnqualComponentName
testInterface :: TestSuite -> TestSuiteInterface
testBuildInfo :: TestSuite -> BuildInfo
testCodeGenerators :: TestSuite -> [FilePath]
..} =
[FilePath]
-> BuildInfo -> ([FilePath], ([DynOption], [PackageName]))
extractFromBuildInfo [FilePath]
mainPath BuildInfo
testBuildInfo
where
mainPath :: [FilePath]
mainPath = case TestSuiteInterface
testInterface of
TestSuiteExeV10 Version
_ FilePath
p -> [FilePath
p]
TestSuiteLibV09 Version
_ ModuleName
p -> [ModuleName -> FilePath
ModuleName.toFilePath ModuleName
p]
TestSuiteUnsupported {} -> []
extractFromBenchmark :: Benchmark -> ([FilePath], ([DynOption], [PackageName]))
extractFromBenchmark Benchmark {UnqualComponentName
BenchmarkInterface
BuildInfo
benchmarkName :: UnqualComponentName
benchmarkInterface :: BenchmarkInterface
benchmarkBuildInfo :: BuildInfo
benchmarkName :: Benchmark -> UnqualComponentName
benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkBuildInfo :: Benchmark -> BuildInfo
..} =
[FilePath]
-> BuildInfo -> ([FilePath], ([DynOption], [PackageName]))
extractFromBuildInfo [FilePath]
mainPath BuildInfo
benchmarkBuildInfo
where
mainPath :: [FilePath]
mainPath = case BenchmarkInterface
benchmarkInterface of
BenchmarkExeV10 Version
_ FilePath
p -> [FilePath
p]
BenchmarkUnsupported {} -> []