-- Copyright 2016 Google Inc. All Rights Reserved.
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | Helper functions to generate proto files as part of a @Setup.hs@ script.
--
-- These functions assume that the @proto-lens-protoc@ executable is on the
-- PATH, and throw an exception otherwise.  That executable will be installed
-- automatically as part of installing this package; in particular, it should
-- be enough to just list `proto-lens-protoc` in a user package's
-- `build-dependencies`.
--
-- See @README.md@ for instructions on how to use proto-lens with Cabal.
{-# 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)

-- | This behaves the same as 'Distribution.Simple.defaultMain', but
-- auto-generates Haskell files from .proto files which are:
--
-- * Listed in the @.cabal@ file under @extra-source-files@,
--
-- * Located under the given root directory, and
--
-- * Correspond to a module (@"Proto.*"@) in `exposed-modules` or
-- `other-modules` of some component in the @.cabal@ file.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
defaultMainGeneratingProtos
    :: FilePath -- ^ The root directory under which .proto files can be found.
    -> IO ()
defaultMainGeneratingProtos :: String -> IO ()
defaultMainGeneratingProtos String
root
    = UserHooks -> IO ()
defaultMainWithHooks forall a b. (a -> b) -> a -> b
$ String -> UserHooks -> UserHooks
generatingProtos String
root UserHooks
simpleUserHooks

-- | This behaves the same as 'Distribution.Simple.defaultMain', but
-- auto-generates Haskell files from the .proto files listed. The given .proto
-- files should be under the given root directory.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
defaultMainGeneratingSpecificProtos
    :: FilePath -- ^ The root directory under which .proto files can be found.
    -> (LocalBuildInfo -> IO [FilePath])
    -- ^ A function to return a list of .proto files. Takes the Cabal package
    -- description as input. Non-absolute paths are treated as relative to the
    -- provided root directory.
    -> IO ()
defaultMainGeneratingSpecificProtos :: String -> (LocalBuildInfo -> IO [String]) -> IO ()
defaultMainGeneratingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos
    = UserHooks -> IO ()
defaultMainWithHooks
    forall a b. (a -> b) -> a -> b
$ String -> (LocalBuildInfo -> IO [String]) -> UserHooks -> UserHooks
generatingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos UserHooks
simpleUserHooks

-- | Augment the given 'UserHooks' to auto-generate Haskell files from the
-- .proto files which are:
--
-- * Listed in the @.cabal@ file under @extra-source-files@,
--
-- * Located under the given root directory, and
--
-- * Correspond to a module (@"Proto.*"@) in `exposed-modules` or
-- `other-modules` of some component in the @.cabal@ file.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
generatingProtos
    :: FilePath -- ^ The root directory under which .proto files can be found.
    -> 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
      -- Replicate Cabal's own logic for parsing file globs.
      [String]
files <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PackageDescription -> String -> IO [String]
match forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
                               (PackageDescription -> [String]
extraSrcFiles forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> String -> String
takeExtension String
f forall a. Eq a => a -> a -> Bool
== String
".proto")
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
makeRelative String
root)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
isSubdirectoryOf String
root)
           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

-- | Augment the given 'UserHooks' to auto-generate Haskell files from the
-- .proto files returned by a function @getProtos@.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
generatingSpecificProtos
    :: FilePath -- ^ The root directory under which .proto files can be found.
    -> (LocalBuildInfo -> IO [FilePath])
    -- ^ A function to return a list of .proto files. Takes the Cabal package
    -- description as input. Non-absolute paths are treated as relative to the
    -- provided root directory.
    -> UserHooks -> UserHooks
generatingSpecificProtos :: String -> (LocalBuildInfo -> IO [String]) -> UserHooks -> UserHooks
generatingSpecificProtos String
root LocalBuildInfo -> IO [String]
getProtos UserHooks
hooks = UserHooks
hooks
    { buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h BuildFlags
f -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l 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
-> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
haddockHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h HaddockFlags
f -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l 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
-> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
replHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h ReplFlags
f [String]
args -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l 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]
-> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postCopy = \[String]
a CopyFlags
flags PackageDescription
pkg LocalBuildInfo
lbi -> do
                  let verb :: Verbosity
verb = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags
                  let destDir :: String
destDir = forall dir. InstallDirs dir -> dir
datadir (PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs String
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi
                                             forall a b. (a -> b) -> a -> b
$ forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags)
                              String -> String -> String
</> String
protoLensImportsPrefix
                  LocalBuildInfo -> IO [String]
getProtos LocalBuildInfo
lbi 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LocalBuildInfo -> [String] -> IO ()
generateSources String
root LocalBuildInfo
l

-- | Generate Haskell source files for the given input .proto files.
--
-- Process all the proto files that are referenced in the exposed-modules
-- or other-modules of some "active" component, and write them all to a
-- single temporary directory.  (For example, passing --no-enable-tests
-- makes all test-suite components inactive.)
--
-- Then, for each active component, copy the corresponding module files
-- over to its specific autogen directory (if Cabal-2.*) or to the global
-- autogen directory (if Cabal-1.*).  However, don't actually do the copy
-- if it's the same as what's already there.  This way, we don't needlessly
-- touch the generated .hs files when nothing changes, and thus don't
-- needlessly make GHC recompile them (as it considers their modification
-- times for that).
generateSources :: FilePath -- ^ The root directory
                -> LocalBuildInfo
                -> [FilePath] -- ^ Proto files relative to the root directory.
                -> IO ()
generateSources :: String -> LocalBuildInfo -> [String] -> IO ()
generateSources String
root LocalBuildInfo
l [String]
files = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"protoc-out" forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
    -- Collect import paths from build-depends of this package.
    [String]
importDirs <- 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
                     ]
    -- Generate .hs files for all active components into a single temporary
    -- directory.
    let activeModules :: [(ComponentLocalBuildInfo, [ModuleName])]
activeModules = LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules LocalBuildInfo
l
    let allModules :: Set ModuleName
allModules = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(ComponentLocalBuildInfo, [ModuleName])]
activeModules
    let usedInComponent :: String -> Bool
usedInComponent String
f = forall a. IsString a => String -> a
ModuleName.fromString (String -> String
protoModuleName String
f)
                          forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ModuleName
allModules
    [String] -> String -> [String] -> IO ()
generateProtosWithImports (String
root forall a. a -> [a] -> [a]
: [String]
importDirs) String
tmpDir
                              -- Applying 'root </>' does nothing if the path is already
                              -- absolute.
                              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String
root String -> String -> String
</>) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
usedInComponent [String]
files
    -- Copy each active component's files over to its autogen directory, but
    -- only if they've changed since last time.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ComponentLocalBuildInfo, [ModuleName])]
activeModules forall a b. (a -> b) -> a -> b
$ \(ComponentLocalBuildInfo
compBI, [ModuleName]
mods) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ModuleName]
mods 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
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sourceExists 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

-- Note: we do a copy rather than a move since a given module may be used in
-- more than one component.
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 forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else do
                -- This could be done in a streaming fashion,
                -- but since the .hs files usually easily fit
                -- into RAM, this is OK.
                ByteString
sourceContents <- String -> IO ByteString
BS.readFile String
sourcePath
                ByteString
targetContents <- String -> IO ByteString
BS.readFile String
targetPath
                forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
sourceContents forall a. Eq a => a -> a -> Bool
== ByteString
targetContents)
    -- Do the move if necessary.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
identical) 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


-- | Copy each .proto file into the installed "data-dir" path,
-- so that it can be included by other packages that depend on this one.
copyProtosToDataDir :: Verbosity
                    -> FilePath -- ^ The root for source .proto files in this
                                -- package.
                    -> FilePath -- ^ The final location where .proto files should
                                -- be installed.
                    -> [FilePath] -- ^ .proto files relative to the root
                    -> IO ()
copyProtosToDataDir :: Verbosity -> String -> String -> [String] -> IO ()
copyProtosToDataDir Verbosity
verb String
root String
destDir [String]
files = do
    -- Make the build more hermetic by clearing the output
    -- directory.
    Bool
exists <- String -> IO Bool
doesDirectoryExist String
destDir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryRecursive String
destDir
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files 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

-- | Imports are stored as $datadir/proto-lens-imports/**/*.proto.
protoLensImportsPrefix :: FilePath
protoLensImportsPrefix :: String
protoLensImportsPrefix = String
"proto-lens-imports"

-- | Returns whether the @root@ is a parent folder of @f@.
isSubdirectoryOf :: FilePath -> FilePath -> Bool
isSubdirectoryOf :: String -> String -> Bool
isSubdirectoryOf String
root String
f
    = String -> Bool
isRelative String
f
      -- Note: `makeRelative root f` returns `f` when f doesn't live under the
      -- root.
      Bool -> Bool -> Bool
&& String -> String -> Bool
equalFilePath String
f (String
root String -> String -> String
</> String -> String -> String
makeRelative String
root String
f)

-- | Run the proto compiler to generate Haskell files from the given .proto files.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
generateProtos
    :: FilePath -- ^ The root directory under which .proto files can be found.
    -> FilePath -- ^ The output directory for the generated Haskell files.
    -> [FilePath] -- ^ The .proto files to process.
    -> IO ()
generateProtos :: String -> String -> [String] -> IO ()
generateProtos String
root = [String] -> String -> [String] -> IO ()
generateProtosWithImports [String
root]
--
-- | Run the proto compiler to generate Haskell files from the given .proto files.
--
-- Writes the generated files to the autogen directory (@dist\/build\/autogen@
-- for Cabal, and @.stack-work\/dist\/...\/build\/autogen@ for stack).
--
-- Throws an exception if the @proto-lens-protoc@ executable is not on the PATH.
generateProtosWithImports
    :: [FilePath] -- ^ Directories under which .proto files and/or files that
                  -- they import can be found.
    -> FilePath -- ^ The output directory for the generated Haskell files.
    -> [FilePath] -- ^ The .proto files to process.
    -> IO ()
generateProtosWithImports :: [String] -> String -> [String] -> IO ()
generateProtosWithImports [String]
_ String
_ [] = 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"
              forall a b. (a -> b) -> a -> b
$ String
"Please file a bug at "
                  forall a. [a] -> [a] -> [a]
++ String
"https://github.com/google/proto-lens/issues ."
    String
protoc <- String -> String -> IO String
findExecutableOrDie String
"protoc"
                forall a b. (a -> b) -> a -> b
$ String
"Follow the installation instructions at "
                    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 forall a b. (a -> b) -> a -> b
$
        [ String
"--plugin=protoc-gen-haskell=" forall a. [a] -> [a] -> [a]
++ String
protoLensProtoc
        , String
"--haskell_out=" forall a. [a] -> [a] -> [a]
++ String
output
        ]
        forall a. [a] -> [a] -> [a]
++ [String
"--proto_path=" forall a. [a] -> [a] -> [a]
++ String
p | String
p <- [String]
imports]
        forall a. [a] -> [a] -> [a]
++ [String]
files

-- | Search the PATH for an executable, printing an error message if it's not
-- found.
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 -> 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 forall a b. (a -> b) -> a -> b
$ String
"Error: couldn't find the executable " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name
                            forall a. [a] -> [a] -> [a]
++ String
" in your $PATH."
                            forall a. [a] -> [a] -> [a]
++ String
"\n    " forall a. [a] -> [a] -> [a]
++ String
debugMsg
            Handle -> String -> IO ()
hPutStrLn Handle
stderr String
sep
            forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Missing executable " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name

-- | Collect all the module names that we need to build.
-- For example: only include test-suites if we're building with tests enabled
-- (e.g., `stack test` vs `stack build`).
collectActiveModules
    :: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules :: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules LocalBuildInfo
l = forall a b. (a -> b) -> [a] -> [b]
map (\(ComponentName
n, ComponentLocalBuildInfo
c) -> (ComponentLocalBuildInfo
c, ComponentName -> [ModuleName]
f ComponentName
n)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList 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
        = forall a. Maybe a -> [a]
maybeToList (PackageDescription -> Maybe Library
library PackageDescription
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    \Library
lib -> Library -> [ModuleName]
exposedModules Library
lib
                                forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules (Library -> BuildInfo
libBuildInfo Library
lib)
    f (CExeName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName Executable
exes forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
    f (CTestName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName TestSuite
tests forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
    f (CBenchName UnqualComponentName
n) = BuildInfo -> [ModuleName]
otherModules forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo forall a b. (a -> b) -> a -> b
$ Map UnqualComponentName Benchmark
benchs forall k a. Ord k => Map k a -> k -> a
Map.! UnqualComponentName
n
    f ComponentName
_ = []  -- TODO: other lib kinds; for now just suppress the warning
    exes :: Map UnqualComponentName Executable
exes = 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 = 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 = 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]

-------------------------------------------------------
-- Compatibility layer between Cabal-1.* and Cabal-2.*

-- | List all the packages that this one depends on.
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 <- [forall a. PackageIndex a -> UnitId -> Maybe a
PackageIndex.lookupUnitId (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
l) UnitId
i]
    forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
p

-- | All the components that will be built by this Cabal command.
allComponents :: LocalBuildInfo -> Map.Map ComponentName ComponentLocalBuildInfo
allComponents :: LocalBuildInfo -> Map ComponentName ComponentLocalBuildInfo
allComponents LocalBuildInfo
l = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Show a => [a] -> a
requireOne forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo]
componentNameMap LocalBuildInfo
l
  where
    -- TODO: this doesn't support Backpack, which can have more than one
    -- ComponentLocalBuildInfo associated with a name.
    requireOne :: [a] -> a
requireOne [a
x] = a
x
    requireOne [a]
xs = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.ProtoLens.Setup.allComponents: expected one "
                          forall a. [a] -> [a] -> [a]
++ String
"component per name, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [a]
xs