{-# 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 qualified Data.Text as T
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,0,0)
, hsSourceDirs
#endif
, libBuildInfo
, otherModules
, testBuildInfo
, testBuildInfo
, testName
)
import qualified Distribution.Simple.BuildPaths as BuildPaths
import Distribution.Simple.InstallDirs (datadir)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..)
, absoluteInstallDirs
, ComponentName(..)
, ComponentLocalBuildInfo
, componentPackageDeps
#if MIN_VERSION_Cabal(2,0,0)
, allComponentsInBuildOrder
, componentNameMap
#endif
)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Setup (fromFlag, copyDest, copyVerbosity)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
, installOrdinaryFile
, matchFileGlob
)
import Distribution.Simple
( defaultMainWithHooks
, simpleUserHooks
, UserHooks(..)
)
import Distribution.Verbosity (Verbosity)
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 qualified Data.ProtoLens.Compiler.Plugin as Plugin
defaultMainGeneratingProtos
:: FilePath
-> IO ()
defaultMainGeneratingProtos root
= defaultMainWithHooks $ generatingProtos root simpleUserHooks
defaultMainGeneratingSpecificProtos
:: FilePath
-> (LocalBuildInfo -> IO [FilePath])
-> IO ()
defaultMainGeneratingSpecificProtos root getProtos
= defaultMainWithHooks
$ generatingSpecificProtos root getProtos simpleUserHooks
generatingProtos
:: FilePath
-> UserHooks -> UserHooks
generatingProtos root = generatingSpecificProtos root getProtos
where
getProtos l = do
files <- concat <$> mapM matchFileGlob (extraSrcFiles $ localPkgDescr l)
pure
. filter (\f -> takeExtension f == ".proto")
. map (makeRelative root)
. filter (isSubdirectoryOf root)
$ files
generatingSpecificProtos
:: FilePath
-> (LocalBuildInfo -> IO [FilePath])
-> UserHooks -> UserHooks
generatingSpecificProtos root getProtos hooks = hooks
{ buildHook = \p l h f -> generate l >> buildHook hooks p l h f
, haddockHook = \p l h f -> generate l >> haddockHook hooks p l h f
, replHook = \p l h f args -> generate l >> replHook hooks p l h f args
#if !MIN_VERSION_Cabal(2,0,0)
, sDistHook = \p maybe_l h f -> case maybe_l of
Nothing -> error "Can't run protoc; run 'cabal configure' first."
Just l -> do
generate l
sDistHook hooks (fudgePackageDesc l p) maybe_l h f
#endif
, postCopy = \a flags pkg lbi -> do
let verb = fromFlag $ copyVerbosity flags
let destDir = datadir (absoluteInstallDirs pkg lbi
$ fromFlag $ copyDest flags)
</> protoLensImportsPrefix
getProtos lbi >>= copyProtosToDataDir verb root destDir
postCopy hooks a flags pkg lbi
}
where
generate l = getProtos l >>= generateSources root 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 root l files = withSystemTempDirectory "protoc-out" $ \tmpDir -> do
-- Collect import paths from build-depends of this package.
importDirs <- filterM doesDirectoryExist
[ InstalledPackageInfo.dataDir info </> protoLensImportsPrefix
| info <- collectDeps l
]
-- Generate .hs files for all active components into a single temporary
-- directory.
let activeModules = collectActiveModules l
let allModules = Set.fromList . concat . map snd $ activeModules
let usedInComponent f = ModuleName.fromString (Plugin.moduleNameStr "Proto" f)
`Set.member` allModules
generateProtosWithImports (root : importDirs) tmpDir
-- Applying 'root </>' does nothing if the path is already
-- absolute.
$ map (root </>) $ filter usedInComponent files
-- Copy each active component's files over to its autogen directory, but
-- only if they've changed since last time.
forM_ activeModules $ \(compBI, mods) -> forM_ mods $ \m -> do
let f = T.unpack (Plugin.outputFilePath $ ModuleName.toFilePath m)
let sourcePath = tmpDir </> f
sourceExists <- doesFileExist sourcePath
when sourceExists $ do
let dest = autogenComponentModulesDir l compBI </> f
copyIfDifferent sourcePath 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 sourcePath targetPath = do
targetExists <- doesFileExist targetPath
identical <- do
if not targetExists
then return False
else do
-- This could be done in a streaming fashion,
-- but since the .hs files usually easily fit
-- into RAM, this is OK.
sourceContents <- BS.readFile sourcePath
targetContents <- BS.readFile targetPath
return (sourceContents == targetContents)
-- Do the move if necessary.
when (not identical) $ do
createDirectoryIfMissing True (takeDirectory targetPath)
copyFile sourcePath 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 verb root destDir files = do
-- Make the build more hermetic by clearing the output
-- directory.
exists <- doesDirectoryExist destDir
when exists $ removeDirectoryRecursive destDir
forM_ files $ \f -> do
let srcFile = root </> f
let destFile = destDir </> f
createDirectoryIfMissingVerbose verb True
(takeDirectory destFile)
installOrdinaryFile verb srcFile destFile
-- | Imports are stored as $datadir/proto-lens-imports/**/*.proto.
protoLensImportsPrefix :: FilePath
protoLensImportsPrefix = "proto-lens-imports"
#if !MIN_VERSION_Cabal(2,0,0)
fudgePackageDesc :: LocalBuildInfo -> PackageDescription -> PackageDescription
fudgePackageDesc lbi p = p
{ library =
(\lib -> lib { libBuildInfo = fudgeBuildInfo CLibName $ libBuildInfo lib })
<$> library p
, executables =
(\exe -> exe { buildInfo = fudgeBuildInfo (CExeName $ exeName exe)
$ buildInfo exe })
<$> executables p
, testSuites =
(\test -> test { testBuildInfo = fudgeBuildInfo (CTestName $ testName test)
$ testBuildInfo test })
<$> testSuites p
, benchmarks =
(\bench -> bench { benchmarkBuildInfo =
fudgeBuildInfo (CBenchName $ benchmarkName bench)
$ benchmarkBuildInfo bench })
<$> benchmarks p
}
where
comps = allComponents lbi
fudgeBuildInfo n bi
| Just compLBI <- Map.lookup n comps
= bi { hsSourceDirs = autogenComponentModulesDir lbi compLBI
: hsSourceDirs bi }
| otherwise = bi
#endif
isSubdirectoryOf :: FilePath -> FilePath -> Bool
isSubdirectoryOf root f
= isRelative f
&& equalFilePath f (root </> makeRelative root f)
generateProtos
:: FilePath
-> FilePath
-> [FilePath]
-> IO ()
generateProtos root = generateProtosWithImports [root]
generateProtosWithImports
:: [FilePath]
-> FilePath
-> [FilePath]
-> IO ()
generateProtosWithImports _ _ [] = return ()
generateProtosWithImports imports output files = do
protoLensProtoc
<- findExecutableOrDie "proto-lens-protoc"
$ "Please file a bug at "
++ "https://github.com/google/proto-lens/issues ."
protoc <- findExecutableOrDie "protoc"
$ "Follow the installation instructions at "
++ "https://google.github.io/proto-lens/installing-protoc.html ."
createDirectoryIfMissing True output
callProcess protoc $
[ "--plugin=protoc-gen-haskell=" ++ protoLensProtoc
, "--haskell_out=" ++ output
]
++ ["--proto_path=" ++ p | p <- imports]
++ files
findExecutableOrDie :: String -> String -> IO FilePath
findExecutableOrDie name debugMsg = do
maybePath <- findExecutable name
case maybePath of
Just path -> return path
Nothing -> do
let sep = "=========="
hPutStrLn stderr sep
hPutStrLn stderr $ "Error: couldn't find the executable " ++ show name
++ " in your $PATH."
++ "\n " ++ debugMsg
hPutStrLn stderr sep
error $ "Missing executable " ++ show name
collectActiveModules
:: LocalBuildInfo -> [(ComponentLocalBuildInfo, [ModuleName])]
collectActiveModules l = map (\(n, c) -> (c, f n)) $ Map.toList $ allComponents l
where
p = localPkgDescr l
f CLibName = maybeToList (library p) >>=
\lib -> exposedModules lib
++ otherModules (libBuildInfo lib)
f (CExeName n) = otherModules . buildInfo $ exes Map.! n
f (CTestName n) = otherModules . testBuildInfo $ tests Map.! n
f (CBenchName n) = otherModules . benchmarkBuildInfo $ benchs Map.! n
#if MIN_VERSION_Cabal(2,0,0)
f _ = []
#endif
exes = Map.fromList [(exeName e, e) | e <- executables p]
tests = Map.fromList [(testName e, e) | e <- testSuites p]
benchs = Map.fromList [(benchmarkName e, e) | e <- benchmarks p]
collectDeps :: LocalBuildInfo -> [InstalledPackageInfo.InstalledPackageInfo]
#if MIN_VERSION_Cabal(2,0,0)
collectDeps l = do
c <- allComponentsInBuildOrder l
(i,_) <- componentPackageDeps c
Just p <- [PackageIndex.lookupUnitId (installedPkgs l) i]
return p
#else
collectDeps l = do
(_, c ,_) <- componentsConfigs l
(_, i) <- componentPackageDeps c
PackageIndex.lookupSourcePackageId (installedPkgs l) i
#endif
allComponents :: LocalBuildInfo -> Map.Map ComponentName ComponentLocalBuildInfo
#if MIN_VERSION_Cabal(2,0,0)
allComponents l = fmap requireOne $ componentNameMap l
where
requireOne [x] = x
requireOne xs = error $ "Data.ProtoLens.Setup.allComponents: expected one "
++ "component per name, got " ++ show xs
#else
allComponents l = Map.fromList [(c, b) | (c, b, _) <- componentsConfigs l]
#endif
autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
#if MIN_VERSION_Cabal(2,0,0)
autogenComponentModulesDir = BuildPaths.autogenComponentModulesDir
#else
autogenComponentModulesDir lbi _ = BuildPaths.autogenModulesDir lbi
#endif