module Distribution.C2Hs ( defaultMainC2Hs
, c2hsBuildHooks
, c2hsHaddockHooks
, c2hsReplHooks
) where
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.Verbosity (Verbosity, normal)
defaultMainC2Hs :: IO ()
defaultMainC2Hs = defaultMainWithHooks
simpleUserHooks { buildHook = c2hsBuildHooks
, haddockHook = c2hsHaddockHooks
, replHook = c2hsReplHooks
}
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 :: ([FilePath] -> [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 :: ([FilePath] -> [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' }
pure $ lib { exposedModules = newMods, libBuildInfo = bi' }
mapBenchmark :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> Benchmark -> IO Benchmark
mapBenchmark f b@Benchmark { benchmarkBuildInfo = bi } = do
bi' <- mapBuildInfo f bi
pure $ b { benchmarkBuildInfo = bi' }
mapExecutable :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> Executable -> IO Executable
mapExecutable f e@Executable { buildInfo = bi } = do
bi' <- mapBuildInfo f bi
pure $ e { buildInfo = bi' }
mapForeignLibrary :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> ForeignLib -> IO ForeignLib
mapForeignLibrary f fl@ForeignLib { foreignLibBuildInfo = bi } = do
bi' <- mapBuildInfo f bi
pure $ fl { foreignLibBuildInfo = bi' }
mapTestSuite :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> TestSuite -> IO TestSuite
mapTestSuite f t@TestSuite { testBuildInfo = bi } = do
bi' <- mapBuildInfo f bi
pure $ t { testBuildInfo = bi' }
mapBuildInfo :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> BuildInfo -> IO BuildInfo
mapBuildInfo f bi@BuildInfo { otherModules = om, hsSourceDirs = dirs } = do
om' <- f dirs om
pure $ bi { otherModules = om' }