Skip to content

Instantly share code, notes, and snippets.

@gergoerdi
Last active March 15, 2021 11:33
Show Gist options
  • Save gergoerdi/2cdc4d984ddf039d650f6a98f2508a96 to your computer and use it in GitHub Desktop.
Save gergoerdi/2cdc4d984ddf039d650f6a98f2508a96 to your computer and use it in GitHub Desktop.
JustBeforeBuildingCabal
import Distribution.Simple
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.Lens
import Data.List (sort, nub)
import Control.Monad (when, forM_)
import System.Directory
import Text.Printf
main :: IO ()
main = defaultMainWithHooks simpleUserHooks
{ buildHook = myBuildHook $ buildHook simpleUserHooks
}
justBeforeBuilding :: LocalBuildInfo -> Component -> IO ()
justBeforeBuilding localInfo c = do
pkgdbs <- absolutePackageDBPaths $ withPackageDB localInfo
let dbpaths = nub . sort $ [ path | SpecificPackageDB path <- pkgdbs ]
dbflags = concat [ ["-package-db", path] | path <- dbpaths ]
putStrLn $ "!!! Processing component " <> show (componentName c)
putStrLn "!!! At this point, the package DB paths are:"
forM_ dbpaths $ \dir -> do
putStrLn dir
files <- listDirectory dir
mapM_ (printf " %s\n") files
restrictBuildFlags :: PackageDescription -> Component -> BuildFlags -> BuildFlags
restrictBuildFlags pkg c buildFlags = buildFlags
{ buildArgs = selectedArgs
}
where
selectedArgs = [showBuildTarget (packageId pkg) $ BuildTargetComponent $ componentName c]
type BuildHook = PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
myBuildHook :: BuildHook -> BuildHook
myBuildHook nextBuildHook pkg localInfo userHooks flags = do
let reqSpec = componentEnabledSpec localInfo
withAllComponentsInBuildOrder pkg localInfo $ \c clbi -> do
flags <- return $ restrictBuildFlags pkg c flags
when (componentEnabled reqSpec c && not (null $ buildArgs flags)) $ do
print $ buildArgs flags
justBeforeBuilding localInfo c
nextBuildHook pkg localInfo userHooks flags
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment