module Data.ProtoLens.Setup
( defaultMainGeneratingProtos
, defaultMainGeneratingSpecificProtos
, generatingProtos
, generatingSpecificProtos
, generateProtosWithImports
, generateProtos
) where
import Control.DeepSeq (force)
import Control.Monad (filterM, forM_, guard, when)
#if MIN_VERSION_Cabal(2,0,0)
import qualified Data.Map as Map
#endif
import qualified Data.ByteString as BS
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
, hsSourceDirs
, libBuildInfo
, otherModules
, testBuildInfo
, testBuildInfo
, testName
)
import qualified Distribution.Simple.BuildPaths as BuildPaths
import Distribution.Simple.InstallDirs (datadir)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..)
, absoluteInstallDirs
, ComponentName(..)
, 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
, getDirectoryContentsRecursive
, installOrdinaryFile
, matchFileGlob
)
import Distribution.Simple
( defaultMainWithHooks
, simpleUserHooks
, UserHooks(..)
)
import Distribution.Verbosity (Verbosity)
import System.FilePath
( (</>)
, equalFilePath
, isRelative
, makeRelative
, takeDirectory
, takeExtension
)
import System.Directory
( createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, findExecutable
, removeDirectoryRecursive
, renameFile
)
import System.IO (hPutStrLn, stderr)
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)
let activeModules = Set.fromList $ collectActiveModules l
pure . filter (\f -> relativeFileToProtoModule f
`Set.member` activeModules)
. filter (\f -> takeExtension f == ".proto")
. map (makeRelative root)
. filter (isSubdirectoryOf root)
$ files
relativeFileToProtoModule
= ModuleName.fromString . Plugin.moduleNameStr "Proto"
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
, 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
, 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
generateSources :: FilePath
-> LocalBuildInfo
-> [FilePath]
-> IO ()
generateSources _ _ [] = return ()
generateSources root l files = do
importDirs <- filterM doesDirectoryExist
[ InstalledPackageInfo.dataDir info </> protoLensImportsPrefix
| info <- collectDeps l
]
let tmpAutogenModulesDir = autogenModulesDir l ++ "-protoc-tmpOutDir"
generateProtosWithImports (root : importDirs) tmpAutogenModulesDir
(map (root </>) files)
!generatedFiles <- force <$> getDirectoryContentsRecursive tmpAutogenModulesDir
forM_ generatedFiles $ \pathRelativeToTmpDir -> do
let sourcePath = tmpAutogenModulesDir </> pathRelativeToTmpDir
let targetPath = autogenModulesDir l </> pathRelativeToTmpDir
identical <- do
targetExists <- doesFileExist targetPath
if not targetExists
then return False
else do
sourceContents <- BS.readFile sourcePath
targetContents <- BS.readFile targetPath
return (sourceContents == targetContents)
when (not identical) $ do
createDirectoryIfMissing True (takeDirectory targetPath)
renameFile sourcePath targetPath
copyProtosToDataDir :: Verbosity
-> FilePath
-> FilePath
-> [FilePath]
-> IO ()
copyProtosToDataDir verb root destDir files = do
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
protoLensImportsPrefix :: FilePath
protoLensImportsPrefix = "proto-lens-imports"
fudgePackageDesc :: LocalBuildInfo -> PackageDescription -> PackageDescription
fudgePackageDesc lbi p = p
{ library =
(\lib -> lib { libBuildInfo = fudgeBuildInfo (libBuildInfo lib) })
<$> library p
, executables =
(\exe -> exe { buildInfo = fudgeBuildInfo (buildInfo exe) })
<$> executables p
, testSuites =
(\test -> test { testBuildInfo = fudgeBuildInfo (testBuildInfo test) })
<$> testSuites p
, benchmarks =
(\bench -> bench { benchmarkBuildInfo =
fudgeBuildInfo (benchmarkBuildInfo bench) })
<$> benchmarks p
}
where
fudgeBuildInfo bi =
bi { hsSourceDirs = autogenModulesDir lbi : hsSourceDirs bi }
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 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 -> [ModuleName]
collectActiveModules l = let
in (activeLib >>= exposedModules)
++ concatMap otherModules
(concat
[ libBuildInfo <$> activeLib
, buildInfo <$> activeExes
, testBuildInfo <$> activeTests
, benchmarkBuildInfo <$> activeBenchmarks
])
where
p = localPkgDescr l
activeLib = guard (active CLibName) >> maybeToList (library p)
activeExes = filter (active . CExeName . exeName) $ executables p
activeTests = filter (active . CTestName . testName) $ testSuites p
activeBenchmarks = filter (active . CBenchName . benchmarkName)
$ benchmarks p
comps = Set.fromList $ allComponentNames l
active = (`Set.member` comps)
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
allComponentNames :: LocalBuildInfo -> [ComponentName]
#if MIN_VERSION_Cabal(2,0,0)
allComponentNames l = Map.keys $ componentNameMap l
#else
allComponentNames l = [c | (c, _, _) <- componentsConfigs l]
#endif
autogenModulesDir :: LocalBuildInfo -> FilePath
#if MIN_VERSION_Cabal(2,0,0)
autogenModulesDir = BuildPaths.autogenPackageModulesDir
#else
autogenModulesDir = BuildPaths.autogenModulesDir
#endif