-- 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 :: FilePath -> IO ()
defaultMainGeneratingProtos FilePath
root
    = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> UserHooks -> UserHooks
generatingProtos FilePath
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 :: FilePath -> (LocalBuildInfo -> IO [FilePath]) -> IO ()
defaultMainGeneratingSpecificProtos FilePath
root LocalBuildInfo -> IO [FilePath]
getProtos
    = UserHooks -> IO ()
defaultMainWithHooks
    (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> (LocalBuildInfo -> IO [FilePath]) -> UserHooks -> UserHooks
generatingSpecificProtos FilePath
root LocalBuildInfo -> IO [FilePath]
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 :: FilePath -> UserHooks -> UserHooks
generatingProtos FilePath
root = FilePath
-> (LocalBuildInfo -> IO [FilePath]) -> UserHooks -> UserHooks
generatingSpecificProtos FilePath
root LocalBuildInfo -> IO [FilePath]
getProtos
  where
    getProtos :: LocalBuildInfo -> IO [FilePath]
getProtos LocalBuildInfo
l = do
      -- Replicate Cabal's own logic for parsing file globs.
      [FilePath]
files <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PackageDescription -> FilePath -> IO [FilePath]
match (PackageDescription -> FilePath -> IO [FilePath])
-> PackageDescription -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
                               (PackageDescription -> [FilePath]
extraSrcFiles (PackageDescription -> [FilePath])
-> PackageDescription -> [FilePath]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
l)
      [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
           ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> FilePath -> FilePath
takeExtension FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".proto")
           ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
makeRelative FilePath
root)
           ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
isSubdirectoryOf FilePath
root)
           ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files

match :: PackageDescription -> FilePath -> IO [FilePath]
#if MIN_VERSION_Cabal(2,4,0)
match :: PackageDescription -> FilePath -> IO [FilePath]
match PackageDescription
desc FilePath
f = Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
normal (PackageDescription -> Version
specVersion PackageDescription
desc) FilePath
"." FilePath
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 :: FilePath
-> (LocalBuildInfo -> IO [FilePath]) -> UserHooks -> UserHooks
generatingSpecificProtos FilePath
root LocalBuildInfo -> IO [FilePath]
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 IO () -> IO () -> IO ()
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 IO () -> IO () -> IO ()
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 -> [FilePath] -> IO ()
replHook = \PackageDescription
p LocalBuildInfo
l UserHooks
h ReplFlags
f [FilePath]
args -> LocalBuildInfo -> IO ()
generate LocalBuildInfo
l IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> ReplFlags
-> [FilePath]
-> IO ()
replHook UserHooks
hooks PackageDescription
p LocalBuildInfo
l UserHooks
h ReplFlags
f [FilePath]
args
    , postCopy :: [FilePath]
-> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postCopy = \[FilePath]
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 :: FilePath
destDir = InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
datadir (PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs FilePath
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi
                                             (CopyDest -> InstallDirs FilePath)
-> CopyDest -> InstallDirs FilePath
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)
                              FilePath -> FilePath -> FilePath
</> FilePath
protoLensImportsPrefix
                  LocalBuildInfo -> IO [FilePath]
getProtos LocalBuildInfo
lbi IO [FilePath] -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> FilePath -> [FilePath] -> IO ()
copyProtosToDataDir Verbosity
verb FilePath
root FilePath
destDir
                  UserHooks
-> [FilePath]
-> CopyFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postCopy UserHooks
hooks [FilePath]
a CopyFlags
flags PackageDescription
pkg LocalBuildInfo
lbi
    }
  where
    generate :: LocalBuildInfo -> IO ()
generate LocalBuildInfo
l = LocalBuildInfo -> IO [FilePath]
getProtos LocalBuildInfo
l IO [FilePath] -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> LocalBuildInfo -> [FilePath] -> IO ()
generateSources FilePath
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 :: FilePath -> LocalBuildInfo -> [FilePath] -> IO ()
generateSources FilePath
root LocalBuildInfo
l [FilePath]
files = FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"protoc-out" ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
    -- Collect import paths from build-depends of this package.
    [FilePath]
importDirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist
                     [ InstalledPackageInfo -> FilePath
InstalledPackageInfo.dataDir InstalledPackageInfo
info FilePath -> FilePath -> FilePath
</> FilePath
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 :: FilePath -> Bool
usedInComponent FilePath
f = FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString (FilePath -> FilePath
protoModuleName FilePath
f)
                          ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ModuleName
allModules
    [FilePath] -> FilePath -> [FilePath] -> IO ()
generateProtosWithImports (FilePath
root FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
importDirs) FilePath
tmpDir
                              -- Applying 'root </>' does nothing if the path is already
                              -- absolute.
                              ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
root FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
usedInComponent [FilePath]
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 :: FilePath
f = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
m FilePath -> FilePath -> FilePath
<.> FilePath
".hs"
          let sourcePath :: FilePath
sourcePath = FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
f
          Bool
sourceExists <- FilePath -> IO Bool
doesFileExist FilePath
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 :: FilePath
dest = LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
autogenComponentModulesDir LocalBuildInfo
l ComponentLocalBuildInfo
compBI FilePath -> FilePath -> FilePath
</> FilePath
f
            FilePath -> FilePath -> IO ()
copyIfDifferent FilePath
sourcePath FilePath
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 :: FilePath -> FilePath -> IO ()
copyIfDifferent FilePath
sourcePath FilePath
targetPath = do
    Bool
targetExists <- FilePath -> IO Bool
doesFileExist FilePath
targetPath
    Bool
identical <- do
        if Bool -> Bool
not Bool
targetExists
            then Bool -> IO Bool
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 <- FilePath -> IO ByteString
BS.readFile FilePath
sourcePath
                ByteString
targetContents <- FilePath -> IO ByteString
BS.readFile FilePath
targetPath
                Bool -> IO Bool
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 -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
targetPath)
        FilePath -> FilePath -> IO ()
copyFile FilePath
sourcePath FilePath
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 -> FilePath -> FilePath -> [FilePath] -> IO ()
copyProtosToDataDir Verbosity
verb FilePath
root FilePath
destDir [FilePath]
files = do
    -- Make the build more hermetic by clearing the output
    -- directory.
    Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
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
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
destDir
    [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
        let srcFile :: FilePath
srcFile = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f
        let destFile :: FilePath
destFile = FilePath
destDir FilePath -> FilePath -> FilePath
</> FilePath
f
        Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verb Bool
True
            (FilePath -> FilePath
takeDirectory FilePath
destFile)
        Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verb FilePath
srcFile FilePath
destFile

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

-- | Returns whether the @root@ is a parent folder of @f@.
isSubdirectoryOf :: FilePath -> FilePath -> Bool
isSubdirectoryOf :: FilePath -> FilePath -> Bool
isSubdirectoryOf FilePath
root FilePath
f
    = FilePath -> Bool
isRelative FilePath
f
      -- Note: `makeRelative root f` returns `f` when f doesn't live under the
      -- root.
      Bool -> Bool -> Bool
&& FilePath -> FilePath -> Bool
equalFilePath FilePath
f (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
root FilePath
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 :: FilePath -> FilePath -> [FilePath] -> IO ()
generateProtos FilePath
root = [FilePath] -> FilePath -> [FilePath] -> IO ()
generateProtosWithImports [FilePath
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 :: [FilePath] -> FilePath -> [FilePath] -> IO ()
generateProtosWithImports [FilePath]
_ FilePath
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
generateProtosWithImports [FilePath]
imports FilePath
output [FilePath]
files = do
    FilePath
protoLensProtoc
        <- FilePath -> FilePath -> IO FilePath
findExecutableOrDie FilePath
"proto-lens-protoc"
              (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Please file a bug at "
                  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"https://github.com/google/proto-lens/issues ."
    FilePath
protoc <- FilePath -> FilePath -> IO FilePath
findExecutableOrDie FilePath
"protoc"
                (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Follow the installation instructions at "
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"https://google.github.io/proto-lens/installing-protoc.html ."
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
output
    FilePath -> [FilePath] -> IO ()
callProcess FilePath
protoc ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [ FilePath
"--plugin=protoc-gen-haskell=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
protoLensProtoc
        , FilePath
"--haskell_out=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
output
        ]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--proto_path=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p | FilePath
p <- [FilePath]
imports]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
files

-- | Search the PATH for an executable, printing an error message if it's not
-- found.
findExecutableOrDie :: String -> String -> IO FilePath
findExecutableOrDie :: FilePath -> FilePath -> IO FilePath
findExecutableOrDie FilePath
name FilePath
debugMsg = do
    Maybe FilePath
maybePath <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
name
    case Maybe FilePath
maybePath of
        Just FilePath
path -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
        Maybe FilePath
Nothing -> do
            let sep :: FilePath
sep = FilePath
"=========="
            Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
sep
            Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: couldn't find the executable " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
name
                            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in your $PATH."
                            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n    " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
debugMsg
            Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
sep
            FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing executable " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ComponentLocalBuildInfo] -> ComponentLocalBuildInfo
forall p. Show p => [p] -> p
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 :: [p] -> p
requireOne [p
x] = p
x
    requireOne [p]
xs = FilePath -> p
forall a. HasCallStack => FilePath -> a
error (FilePath -> p) -> FilePath -> p
forall a b. (a -> b) -> a -> b
$ FilePath
"Data.ProtoLens.Setup.allComponents: expected one "
                          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"component per name, got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [p] -> FilePath
forall a. Show a => a -> FilePath
show [p]
xs