-- 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 (UserHooks -> IO ()) -> UserHooks -> IO ()
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
    (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

-- | 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 <- [[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

-- | 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
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

-- | 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 = 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
    -- Collect import paths from build-depends of this package.
    [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
                     ]
    -- 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 = [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
                              -- Applying 'root </>' does nothing if the path is already
                              -- absolute.
                              ([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
    -- Copy each active component's files over to its autogen directory, but
    -- only if they've changed since last time.
    [(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

-- 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 Bool -> IO Bool
forall a. a -> IO a
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
                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)
    -- Do the move if necessary.
    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


-- | 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
    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

-- | 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
_ [] = () -> 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

-- | 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 -> 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

-- | 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 = ((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
_ = []  -- TODO: other lib kinds; for now just suppress the warning
    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]

-------------------------------------------------------
-- 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 <- [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

-- | 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 = ([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
    -- 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 = 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