{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Data.ProtoLens.Setup
( defaultMainGeneratingProtos
, defaultMainGeneratingSpecificProtos
, generatingProtos
, generatingSpecificProtos
, generateProtosWithImports
, generateProtos
) where
import Control.Monad (filterM, forM_, when)
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Data.Maybe (maybeToList)
import qualified Data.Set as Set
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.PackageDescription
( PackageDescription(..)
, benchmarkBuildInfo
, benchmarkName
, buildInfo
, exeName
, exposedModules
, extraSrcFiles
#if MIN_VERSION_Cabal(2,4,0)
, specVersion
#endif
, libBuildInfo
, otherModules
, testBuildInfo
, testBuildInfo
, testName
)
import Distribution.Simple.BuildPaths (autogenComponentModulesDir)
import Distribution.Simple.InstallDirs (datadir)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..)
, absoluteInstallDirs
, ComponentName(..)
, ComponentLocalBuildInfo
, componentPackageDeps
, allComponentsInBuildOrder
, componentNameMap
#if MIN_VERSION_Cabal(3,0,0)
, LibraryName(..)
#endif
)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Setup (fromFlag, copyDest, copyVerbosity)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
, installOrdinaryFile
#if MIN_VERSION_Cabal(2,4,0)
#else
, matchFileGlob
#endif
)
#if MIN_VERSION_Cabal(2,4,0)
import Distribution.Simple.Glob (matchDirFileGlob)
#endif
import Distribution.Simple
( defaultMainWithHooks
, simpleUserHooks
, UserHooks(..)
)
import Distribution.Verbosity
( Verbosity
#if MIN_VERSION_Cabal(2,4,0)
, normal
#endif
)
import System.FilePath
( (</>)
, (<.>)
, equalFilePath
, isRelative
, makeRelative
, takeDirectory
, takeExtension
)
import System.Directory
( copyFile
, createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, findExecutable
, removeDirectoryRecursive
)
import System.IO (hPutStrLn, stderr)
import System.IO.Temp (withSystemTempDirectory)
import System.Process (callProcess)
import Data.ProtoLens.Compiler.ModuleName (protoModuleName)
defaultMainGeneratingProtos
:: FilePath
-> IO ()
defaultMainGeneratingProtos :: String -> IO ()
defaultMainGeneratingProtos String
root
= UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> UserHooks -> UserHooks
generatingProtos String
root UserHooks
simpleUserHooks
defaultMainGeneratingSpecificProtos
:: FilePath
-> (LocalBuildInfo -> IO [FilePath])
-> IO ()
defaultMainGeneratingSpecificProtos :: String -> (LocalBuildInfo -> IO [String]) -> IO ()
defaultMainGeneratingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos
= UserHooks -> IO ()
defaultMainWithHooks
(UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (LocalBuildInfo -> IO [String]) -> UserHooks -> UserHooks
generatingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos UserHooks
simpleUserHooks
generatingProtos
:: FilePath
-> UserHooks -> UserHooks
generatingProtos :: String -> UserHooks -> UserHooks
generatingProtos String
root = String -> (LocalBuildInfo -> IO [String]) -> UserHooks -> UserHooks
generatingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos
where
getProtos :: LocalBuildInfo -> IO [String]
getProtos LocalBuildInfo
l = do
[String]
files <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PackageDescription -> String -> IO [String]
match (PackageDescription -> String -> IO [String])
-> PackageDescription -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
(PackageDescription -> [String]
extraSrcFiles (PackageDescription -> [String]) -> PackageDescription -> [String]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
[String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> String -> String
takeExtension String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".proto")
([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
makeRelative String
root)
([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
isSubdirectoryOf String
root)
([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
files
match :: PackageDescription -> FilePath -> IO [FilePath]
#if MIN_VERSION_Cabal(2,4,0)
match :: PackageDescription -> String -> IO [String]
match PackageDescription
desc String
f = Verbosity -> CabalSpecVersion -> String -> String -> IO [String]
matchDirFileGlob Verbosity
normal (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
desc) String
"." String
f
#else
match _ f = matchFileGlob f
#endif
generatingSpecificProtos
:: FilePath
-> (LocalBuildInfo -> IO [FilePath])
-> UserHooks -> UserHooks
generatingSpecificProtos :: String -> (LocalBuildInfo -> IO [String]) -> UserHooks -> UserHooks
generatingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos UserHooks
hooks = UserHooks
hooks
{ buildHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h BuildFlags
f -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
hooks PackageDescription
p LocalBuildInfo
l UserHooks
h BuildFlags
f
, haddockHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h HaddockFlags
f -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> HaddockFlags
-> IO ()
haddockHook UserHooks
hooks PackageDescription
p LocalBuildInfo
l UserHooks
h HaddockFlags
f
, replHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h ReplFlags
f [String]
args -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> ReplFlags
-> [String]
-> IO ()
replHook UserHooks
hooks PackageDescription
p LocalBuildInfo
l UserHooks
h ReplFlags
f [String]
args
, postCopy = \[String]
a CopyFlags
flags PackageDescription
pkg LocalBuildInfo
lbi -> do
let verb :: Verbosity
verb = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags
let destDir :: String
destDir = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
datadir (PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs String
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi
(CopyDest -> InstallDirs String) -> CopyDest -> InstallDirs String
forall a b. (a -> b) -> a -> b
$ Flag CopyDest -> CopyDest
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag CopyDest -> CopyDest) -> Flag CopyDest -> CopyDest
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags)
String -> String -> String
</> String
protoLensImportsPrefix
LocalBuildInfo -> IO [String]
getProtos LocalBuildInfo
lbi IO [String] -> ([String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> String -> String -> [String] -> IO ()
copyProtosToDataDir Verbosity
verb String
root String
destDir
UserHooks
-> [String]
-> CopyFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postCopy UserHooks
hooks [String]
a CopyFlags
flags PackageDescription
pkg LocalBuildInfo
lbi
}
where
generate :: LocalBuildInfo -> IO ()
generate LocalBuildInfo
l = LocalBuildInfo -> IO [String]
getProtos LocalBuildInfo
l IO [String] -> ([String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LocalBuildInfo -> [String] -> IO ()
generateSources String
root LocalBuildInfo
l
generateSources :: FilePath
-> LocalBuildInfo
-> [FilePath]
-> IO ()
generateSources :: String -> LocalBuildInfo -> [String] -> IO ()
generateSources String
root LocalBuildInfo
l [String]
files = String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"protoc-out" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
[String]
importDirs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist
[ InstalledPackageInfo -> String
InstalledPackageInfo.dataDir InstalledPackageInfo
info String -> String -> String
</> String
protoLensImportsPrefix
| InstalledPackageInfo
info <- LocalBuildInfo -> [InstalledPackageInfo]
collectDeps LocalBuildInfo
l
]
let activeModules :: [(ComponentLocalBuildInfo, [ModuleName])]
activeModules = LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules LocalBuildInfo
l
let allModules :: Set ModuleName
allModules = [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName)
-> ([(ComponentLocalBuildInfo, [ModuleName])] -> [ModuleName])
-> [(ComponentLocalBuildInfo, [ModuleName])]
-> Set ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ModuleName]] -> [ModuleName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ModuleName]] -> [ModuleName])
-> ([(ComponentLocalBuildInfo, [ModuleName])] -> [[ModuleName]])
-> [(ComponentLocalBuildInfo, [ModuleName])]
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ComponentLocalBuildInfo, [ModuleName]) -> [ModuleName])
-> [(ComponentLocalBuildInfo, [ModuleName])] -> [[ModuleName]]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentLocalBuildInfo, [ModuleName]) -> [ModuleName]
forall a b. (a, b) -> b
snd ([(ComponentLocalBuildInfo, [ModuleName])] -> Set ModuleName)
-> [(ComponentLocalBuildInfo, [ModuleName])] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ [(ComponentLocalBuildInfo, [ModuleName])]
activeModules
let usedInComponent :: String -> Bool
usedInComponent String
f = String -> ModuleName
forall a. IsString a => String -> a
ModuleName.fromString (String -> String
protoModuleName String
f)
ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ModuleName
allModules
[String] -> String -> [String] -> IO ()
generateProtosWithImports (String
root String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
importDirs) String
tmpDir
([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
root String -> String -> String
</>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
usedInComponent [String]
files
[(ComponentLocalBuildInfo, [ModuleName])]
-> ((ComponentLocalBuildInfo, [ModuleName]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ComponentLocalBuildInfo, [ModuleName])]
activeModules (((ComponentLocalBuildInfo, [ModuleName]) -> IO ()) -> IO ())
-> ((ComponentLocalBuildInfo, [ModuleName]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ComponentLocalBuildInfo
compBI, [ModuleName]
mods) -> [ModuleName] -> (ModuleName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ModuleName]
mods ((ModuleName -> IO ()) -> IO ()) -> (ModuleName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> do
let f :: String
f = ModuleName -> String
ModuleName.toFilePath ModuleName
m String -> String -> String
<.> String
".hs"
let sourcePath :: String
sourcePath = String
tmpDir String -> String -> String
</> String
f
Bool
sourceExists <- String -> IO Bool
doesFileExist String
sourcePath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sourceExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let dest :: String
dest = LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
l ComponentLocalBuildInfo
compBI String -> String -> String
</> String
f
String -> String -> IO ()
copyIfDifferent String
sourcePath String
dest
copyIfDifferent :: FilePath -> FilePath -> IO ()
copyIfDifferent :: String -> String -> IO ()
copyIfDifferent String
sourcePath String
targetPath = do
Bool
targetExists <- String -> IO Bool
doesFileExist String
targetPath
Bool
identical <- do
if Bool -> Bool
not Bool
targetExists
then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
ByteString
sourceContents <- String -> IO ByteString
BS.readFile String
sourcePath
ByteString
targetContents <- String -> IO ByteString
BS.readFile String
targetPath
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
sourceContents ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
targetContents)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
identical) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
targetPath)
String -> String -> IO ()
copyFile String
sourcePath String
targetPath
copyProtosToDataDir :: Verbosity
-> FilePath
-> FilePath
-> [FilePath]
-> IO ()
copyProtosToDataDir :: Verbosity -> String -> String -> [String] -> IO ()
copyProtosToDataDir Verbosity
verb String
root String
destDir [String]
files = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
destDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
destDir
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
f -> do
let srcFile :: String
srcFile = String
root String -> String -> String
</> String
f
let destFile :: String
destFile = String
destDir String -> String -> String
</> String
f
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verb Bool
True
(String -> String
takeDirectory String
destFile)
Verbosity -> String -> String -> IO ()
installOrdinaryFile Verbosity
verb String
srcFile String
destFile
protoLensImportsPrefix :: FilePath
protoLensImportsPrefix :: String
protoLensImportsPrefix = String
"proto-lens-imports"
isSubdirectoryOf :: FilePath -> FilePath -> Bool
isSubdirectoryOf :: String -> String -> Bool
isSubdirectoryOf String
root String
f
= String -> Bool
isRelative String
f
Bool -> Bool -> Bool
&& String -> String -> Bool
equalFilePath String
f (String
root String -> String -> String
</> String -> String -> String
makeRelative String
root String
f)
generateProtos
:: FilePath
-> FilePath
-> [FilePath]
-> IO ()
generateProtos :: String -> String -> [String] -> IO ()
generateProtos String
root = [String] -> String -> [String] -> IO ()
generateProtosWithImports [String
root]
generateProtosWithImports
:: [FilePath]
-> FilePath
-> [FilePath]
-> IO ()
generateProtosWithImports :: [String] -> String -> [String] -> IO ()
generateProtosWithImports [String]
_ String
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
generateProtosWithImports [String]
imports String
output [String]
files = do
String
protoLensProtoc
<- String -> String -> IO String
findExecutableOrDie String
"proto-lens-protoc"
(String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Please file a bug at "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"https://github.com/google/proto-lens/issues ."
String
protoc <- String -> String -> IO String
findExecutableOrDie String
"protoc"
(String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Follow the installation instructions at "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"https://google.github.io/proto-lens/installing-protoc.html ."
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
output
String -> [String] -> IO ()
callProcess String
protoc ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ String
"--plugin=protoc-gen-haskell=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
protoLensProtoc
, String
"--haskell_out=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
output
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--proto_path=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p | String
p <- [String]
imports]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
files
findExecutableOrDie :: String -> String -> IO FilePath
findExecutableOrDie :: String -> String -> IO String
findExecutableOrDie String
name String
debugMsg = do
Maybe String
maybePath <- String -> IO (Maybe String)
findExecutable String
name
case Maybe String
maybePath of
Just String
path -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
Maybe String
Nothing -> do
let sep :: String
sep = String
"=========="
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
sep
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: couldn't find the executable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in your $PATH."
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
debugMsg
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
sep
String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Missing executable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name
collectActiveModules
:: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules :: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules LocalBuildInfo
l = ((ComponentName, ComponentLocalBuildInfo)
-> (ComponentLocalBuildInfo, [ModuleName]))
-> [(ComponentName, ComponentLocalBuildInfo)]
-> [(ComponentLocalBuildInfo, [ModuleName])]
forall a b. (a -> b) -> [a] -> [b]
map (\(ComponentName
n, ComponentLocalBuildInfo
c) -> (ComponentLocalBuildInfo
c, ComponentName -> [ModuleName]
f ComponentName
n)) ([(ComponentName, ComponentLocalBuildInfo)]
-> [(ComponentLocalBuildInfo, [ModuleName])])
-> [(ComponentName, ComponentLocalBuildInfo)]
-> [(ComponentLocalBuildInfo, [ModuleName])]
forall a b. (a -> b) -> a -> b
$ Map ComponentName ComponentLocalBuildInfo
-> [(ComponentName, ComponentLocalBuildInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ComponentName ComponentLocalBuildInfo
-> [(ComponentName, ComponentLocalBuildInfo)])
-> Map ComponentName ComponentLocalBuildInfo
-> [(ComponentName, ComponentLocalBuildInfo)]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Map ComponentName ComponentLocalBuildInfo
allComponents LocalBuildInfo
l
where
p :: PackageDescription
p = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l
#if MIN_VERSION_Cabal(3,0,0)
f :: ComponentName -> [ModuleName]
f (CLibName LibraryName
LMainLibName)
#else
f CLibName
#endif
= Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList (PackageDescription -> Maybe Library
library PackageDescription
p) [Library] -> (Library -> [ModuleName]) -> [ModuleName]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\Library
lib -> Library -> [ModuleName]
exposedModules Library
lib
[ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules (Library -> BuildInfo
libBuildInfo Library
lib)
f (CExeName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules (BuildInfo -> [ModuleName])
-> (Executable -> BuildInfo) -> Executable -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo (Executable -> [ModuleName]) -> Executable -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName Executable
exes Map UnqualComponentName Executable
-> UnqualComponentName -> Executable
forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
f (CTestName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules (BuildInfo -> [ModuleName])
-> (TestSuite -> BuildInfo) -> TestSuite -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo (TestSuite -> [ModuleName]) -> TestSuite -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName TestSuite
tests Map UnqualComponentName TestSuite
-> UnqualComponentName -> TestSuite
forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
f (CBenchName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules (BuildInfo -> [ModuleName])
-> (Benchmark -> BuildInfo) -> Benchmark -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo (Benchmark -> [ModuleName]) -> Benchmark -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName Benchmark
benchs Map UnqualComponentName Benchmark
-> UnqualComponentName -> Benchmark
forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
f ComponentName
_ = []
exes :: Map UnqualComponentName Executable
exes = [(UnqualComponentName, Executable)]
-> Map UnqualComponentName Executable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Executable -> UnqualComponentName
exeName Executable
e, Executable
e) | Executable
e <- PackageDescription -> [Executable]
executables PackageDescription
p]
tests :: Map UnqualComponentName TestSuite
tests = [(UnqualComponentName, TestSuite)]
-> Map UnqualComponentName TestSuite
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TestSuite -> UnqualComponentName
testName TestSuite
e, TestSuite
e) | TestSuite
e <- PackageDescription -> [TestSuite]
testSuites PackageDescription
p]
benchs :: Map UnqualComponentName Benchmark
benchs = [(UnqualComponentName, Benchmark)]
-> Map UnqualComponentName Benchmark
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Benchmark -> UnqualComponentName
benchmarkName Benchmark
e, Benchmark
e) | Benchmark
e <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
p]
collectDeps :: LocalBuildInfo -> [InstalledPackageInfo.InstalledPackageInfo]
collectDeps :: LocalBuildInfo -> [InstalledPackageInfo]
collectDeps LocalBuildInfo
l = do
ComponentLocalBuildInfo
c <- LocalBuildInfo -> [ComponentLocalBuildInfo]
allComponentsInBuildOrder LocalBuildInfo
l
(UnitId
i,MungedPackageId
_) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
c
Just InstalledPackageInfo
p <- [PackageIndex InstalledPackageInfo
-> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
PackageIndex.lookupUnitId (LocalBuildInfo -> PackageIndex InstalledPackageInfo
installedPkgs LocalBuildInfo
l) UnitId
i]
InstalledPackageInfo -> [InstalledPackageInfo]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
p
allComponents :: LocalBuildInfo -> Map.Map ComponentName ComponentLocalBuildInfo
allComponents :: LocalBuildInfo -> Map ComponentName ComponentLocalBuildInfo
allComponents LocalBuildInfo
l = ([ComponentLocalBuildInfo] -> ComponentLocalBuildInfo)
-> Map ComponentName [ComponentLocalBuildInfo]
-> Map ComponentName ComponentLocalBuildInfo
forall a b. (a -> b) -> Map ComponentName a -> Map ComponentName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ComponentLocalBuildInfo] -> ComponentLocalBuildInfo
forall {a}. Show a => [a] -> a
requireOne (Map ComponentName [ComponentLocalBuildInfo]
-> Map ComponentName ComponentLocalBuildInfo)
-> Map ComponentName [ComponentLocalBuildInfo]
-> Map ComponentName ComponentLocalBuildInfo
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap LocalBuildInfo
l
where
requireOne :: [a] -> a
requireOne [a
x] = a
x
requireOne [a]
xs = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.ProtoLens.Setup.allComponents: expected one "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"component per name, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
xs