-- | Everything in this module is slightly morally dubious in that it works by -- considering *all* modules to be @exposed-modules@ in the preprocessor phase. -- -- This works in practice, but the Cabal API provides no guarantees this will -- continue to be the case in the future. module Distribution.C2Hs ( defaultMainC2Hs -- * User hooks , c2hsUserHooks -- * Specialized hooks , c2hsBuildHooks , c2hsHaddockHooks , c2hsReplHooks ) where import Control.Applicative (pure) import Data.Traversable (traverse) import Distribution.C2Hs.TopSort import Distribution.ModuleName (ModuleName) import Distribution.Simple (UserHooks (buildHook, haddockHook, replHook), defaultMainWithHooks, simpleUserHooks) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) import Distribution.Simple.Setup (BuildFlags (BuildFlags, buildVerbosity), HaddockFlags (HaddockFlags, haddockVerbosity), ReplFlags (ReplFlags, replVerbosity), fromFlagOrDefault) import Distribution.Types.Benchmark import Distribution.Types.BuildInfo import Distribution.Types.Executable import Distribution.Types.ForeignLib import Distribution.Types.Library import Distribution.Types.PackageDescription import Distribution.Types.TestSuite import Distribution.Utils.Path (PackageDir, SourceDir, SymbolicPath, getSymbolicPath) import Distribution.Verbosity (Verbosity, normal) type CabalFP = SymbolicPath PackageDir SourceDir defaultMainC2Hs :: IO () defaultMainC2Hs = defaultMainWithHooks c2hsUserHooks -- | @since 0.1.1.0 c2hsUserHooks :: UserHooks c2hsUserHooks = simpleUserHooks { buildHook = c2hsBuildHooks , haddockHook = c2hsHaddockHooks , replHook = c2hsReplHooks } reorderC2Hs' :: Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName] reorderC2Hs' v fps = reorderC2Hs v (fmap getSymbolicPath fps) -- | Custom build hooks to be used with @.chs@ files which @{\#import\#}@ one -- another. c2hsBuildHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO () c2hsBuildHooks = \pd lbi hooks bf -> do let v = getVerbosity bf pd' <- mapPackageDescription (reorderC2Hs' v) pd buildHook simpleUserHooks pd' lbi hooks bf c2hsHaddockHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO () c2hsHaddockHooks = \pd lbi hooks hf -> do let v = getHaddockVerbosity hf pd' <- mapPackageDescription (reorderC2Hs' v) pd haddockHook simpleUserHooks pd' lbi hooks hf c2hsReplHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO () c2hsReplHooks = \pd lbi hooks rf ss -> do let v = getReplVerbosity rf pd' <- mapPackageDescription (reorderC2Hs' v) pd replHook simpleUserHooks pd' lbi hooks rf ss getHaddockVerbosity :: HaddockFlags -> Verbosity getHaddockVerbosity HaddockFlags { haddockVerbosity = v } = fromFlagOrDefault normal v getVerbosity :: BuildFlags -> Verbosity getVerbosity BuildFlags { buildVerbosity = v } = fromFlagOrDefault normal v getReplVerbosity :: ReplFlags -> Verbosity getReplVerbosity ReplFlags { replVerbosity = v } = fromFlagOrDefault normal v mapPackageDescription :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> PackageDescription -> IO PackageDescription mapPackageDescription f p@PackageDescription { library = ml , subLibraries = ls , executables = es , foreignLibs = fs , testSuites = ts , benchmarks = bs } = do ml' <- traverse (mapLibrary f) ml ls' <- traverse (mapLibrary f) ls es' <- traverse (mapExecutable f) es fs' <- traverse (mapForeignLibrary f) fs ts' <- traverse (mapTestSuite f) ts bs' <- traverse (mapBenchmark f) bs pure $ p { library = ml' , subLibraries = ls' , executables = es' , foreignLibs = fs' , testSuites = ts' , benchmarks = bs' } mapLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Library -> IO Library mapLibrary f lib@Library { exposedModules = es, libBuildInfo = bi } = do let dirs = hsSourceDirs bi om = otherModules bi isOther = (`notElem` es) newMods <- f dirs (es ++ om) let om' = filter isOther newMods bi' = bi { otherModules = om' } -- This is stupid, but I've tested it and it seems to not do anything -- egregious pure $ lib { exposedModules = newMods, libBuildInfo = bi' } mapBenchmark :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Benchmark -> IO Benchmark mapBenchmark f b@Benchmark { benchmarkBuildInfo = bi } = do bi' <- mapBuildInfo f bi pure $ b { benchmarkBuildInfo = bi' } mapExecutable :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Executable -> IO Executable mapExecutable f e@Executable { buildInfo = bi } = do bi' <- mapBuildInfo f bi pure $ e { buildInfo = bi' } mapForeignLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> ForeignLib -> IO ForeignLib mapForeignLibrary f fl@ForeignLib { foreignLibBuildInfo = bi } = do bi' <- mapBuildInfo f bi pure $ fl { foreignLibBuildInfo = bi' } mapTestSuite :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> TestSuite -> IO TestSuite mapTestSuite f t@TestSuite { testBuildInfo = bi } = do bi' <- mapBuildInfo f bi pure $ t { testBuildInfo = bi' } mapBuildInfo :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> BuildInfo -> IO BuildInfo mapBuildInfo f bi@BuildInfo { otherModules = om, hsSourceDirs = dirs } = do om' <- f dirs om pure $ bi { otherModules = om' }