Simplify Setup.hs by renaming int. exe into place
This commit is contained in:
128
Setup.hs
128
Setup.hs
@@ -1,14 +1,19 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
|
||||
import Distribution.Simple
|
||||
import Distribution.Simple.Utils
|
||||
import Distribution.Simple.Setup
|
||||
import Distribution.Simple.Install
|
||||
import Distribution.Simple.Program
|
||||
import Distribution.Simple.Register
|
||||
import Distribution.Simple.InstallDirs as ID
|
||||
import Distribution.Simple.BuildPaths
|
||||
import qualified Distribution.Simple.InstallDirs as ID
|
||||
import Distribution.Simple.LocalBuildInfo
|
||||
import Distribution.PackageDescription
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Map (Map)
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
@@ -19,38 +24,131 @@ import Data.Monoid
|
||||
import System.Process
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
|
||||
import SetupCompat
|
||||
import System.Directory (renameFile)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMainWithHooks $ simpleUserHooks {
|
||||
instHook = inst,
|
||||
copyHook = copy,
|
||||
|
||||
confHook = \(gpd, hbi) cf ->
|
||||
xBuildDependsLike <$> (confHook simpleUserHooks) (gpd, hbi) cf
|
||||
|
||||
, buildHook = \pd lbi hooks flags -> (buildHook simpleUserHooks) pd (patchLibexecdir lbi) hooks flags
|
||||
, hookedPrograms = [ simpleProgram "shelltest" ]
|
||||
}
|
||||
|
||||
patchLibexecdir :: LocalBuildInfo -> LocalBuildInfo
|
||||
patchLibexecdir lbi = let
|
||||
idirtpl = installDirTemplates lbi
|
||||
libexecdir' = toPathTemplate $ fromPathTemplate (libexecdir idirtpl) </> "$abi/$pkgid"
|
||||
lbi' = lbi { installDirTemplates = idirtpl { libexecdir = libexecdir' } }
|
||||
in
|
||||
lbi'
|
||||
|
||||
|
||||
xBuildDependsLike :: LocalBuildInfo -> LocalBuildInfo
|
||||
xBuildDependsLike lbi =
|
||||
let
|
||||
cc = componentsConfigs lbi
|
||||
pd = localPkgDescr lbi
|
||||
deps = dependsMap lbi
|
||||
in setComponentsConfigs lbi
|
||||
[ (cn, updateClbi deps comp clbi, cdeps)
|
||||
| (cn, clbi, cdeps) <- cc
|
||||
, let comp = getComponent pd cn
|
||||
]
|
||||
|
||||
in lbi {
|
||||
componentsConfigs =
|
||||
[ (cn, updateClbi deps comp clbi, cdeps)
|
||||
| (cn, clbi, cdeps) <- cc
|
||||
, let comp = getComponent pd cn
|
||||
]
|
||||
}
|
||||
where
|
||||
updateClbi deps comp clbi = setUnionDeps (otherDeps deps comp) clbi
|
||||
|
||||
dependsMap ::
|
||||
LocalBuildInfo -> [(ComponentName, Deps)]
|
||||
-- dependsMap ::
|
||||
-- LocalBuildInfo -> [(ComponentName, ([(UnitId, PackageId)], Map PackageName ModuleRenaming))]
|
||||
dependsMap lbi =
|
||||
second getDeps <$> allComponentsInBuildOrder lbi
|
||||
second (componentPackageDeps &&& componentPackageRenaming)
|
||||
<$> allComponentsInBuildOrder lbi
|
||||
|
||||
otherDeps :: [(ComponentName, Deps)] -> Component -> Deps
|
||||
otherDeps deps comp = fromMaybe noDeps $
|
||||
-- otherDeps :: [(ComponentName, ([(UnitId, PackageId)], Map PackageName ModuleRenaming))] -> Component -> ([(UnitId, PackageId)], Map PackageName ModuleRenaming)
|
||||
otherDeps deps comp = fromMaybe ([], M.empty) $
|
||||
flip lookup deps =<< read <$> lookup "x-build-depends-like" fields
|
||||
where
|
||||
fields = customFieldsBI (componentBuildInfo comp)
|
||||
|
||||
setComponentPackageRenaming clbi cprn =
|
||||
clbi { componentPackageRenaming =
|
||||
componentPackageRenaming clbi `M.union` cprn }
|
||||
|
||||
-- setUnionDeps :: ([(UnitId, PackageId)], Map PackageName ModuleRenaming) -> ComponentLocalBuildInfo -> ComponentLocalBuildInfo
|
||||
setUnionDeps (deps, rns) clbi = let
|
||||
clbi' = setComponentPackageRenaming clbi rns
|
||||
cpdeps = componentPackageDeps clbi
|
||||
in
|
||||
clbi' {
|
||||
componentPackageDeps = cpdeps `union` deps
|
||||
}
|
||||
|
||||
|
||||
-- mostly copypasta from 'defaultInstallHook'
|
||||
inst ::
|
||||
PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()
|
||||
inst pd lbi _uf ifl = do
|
||||
let copyFlags = defaultCopyFlags {
|
||||
copyDistPref = installDistPref ifl,
|
||||
copyDest = toFlag NoCopyDest,
|
||||
copyVerbosity = installVerbosity ifl
|
||||
}
|
||||
xInstallTarget pd lbi copyFlags (\pd' lbi' -> install pd' lbi' copyFlags)
|
||||
let registerFlags = defaultRegisterFlags {
|
||||
regDistPref = installDistPref ifl,
|
||||
regInPlace = installInPlace ifl,
|
||||
regPackageDB = installPackageDB ifl,
|
||||
regVerbosity = installVerbosity ifl
|
||||
}
|
||||
when (hasLibs pd) $ register pd lbi registerFlags
|
||||
|
||||
copy :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
|
||||
copy pd lbi _uh cf =
|
||||
xInstallTarget pd lbi cf (\pd' lbi' -> install pd' lbi' cf)
|
||||
|
||||
xInstallTarget :: PackageDescription
|
||||
-> LocalBuildInfo
|
||||
-> CopyFlags
|
||||
-> (PackageDescription -> LocalBuildInfo -> IO ())
|
||||
-> IO ()
|
||||
xInstallTarget pd lbi cf fn = do
|
||||
let (extended, regular) = partition isInternal (executables pd)
|
||||
|
||||
let pd_regular = pd { executables = regular }
|
||||
|
||||
_ <- flip mapM extended $ \exe -> do
|
||||
let pd_extended = onlyExePackageDesc [exe] pd
|
||||
fn pd_extended lbi
|
||||
|
||||
let lbi' = patchLibexecdir lbi
|
||||
copydest = fromFlag (copyDest cf)
|
||||
verbosity = fromFlag (copyVerbosity cf)
|
||||
InstallDirs { bindir, libexecdir } = absoluteInstallDirs pd lbi' copydest
|
||||
progprefix = substPathTemplate (packageId pd) lbi (progPrefix lbi)
|
||||
progsuffix = substPathTemplate (packageId pd) lbi (progSuffix lbi)
|
||||
fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix
|
||||
|
||||
fixedExeFileName = bindir </> fixedExeBaseName <.> exeExtension
|
||||
newExeFileName = libexecdir </> fixedExeBaseName <.> exeExtension
|
||||
|
||||
when (exeName exe == "ghc-mod-real") $ do
|
||||
createDirectoryIfMissingVerbose verbosity True libexecdir
|
||||
renameFile fixedExeFileName newExeFileName
|
||||
|
||||
fn pd_regular lbi
|
||||
|
||||
where
|
||||
isInternal :: Executable -> Bool
|
||||
isInternal exe =
|
||||
fromMaybe False $ (=="True") <$> lookup "x-internal" (customFieldsBI $ buildInfo exe)
|
||||
|
||||
onlyExePackageDesc :: [Executable] -> PackageDescription -> PackageDescription
|
||||
onlyExePackageDesc exes pd = emptyPackageDescription {
|
||||
package = package pd
|
||||
, executables = exes
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user