{-# LANGUAGE DataKinds #-}
module Distribution.C2Hs ( defaultMainC2Hs
, c2hsUserHooks
, 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, buildCommonFlags,
HaddockFlags, haddockCommonFlags,
ReplFlags, replCommonFlags,
CommonSetupFlags (CommonSetupFlags, setupVerbosity),
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 (Pkg, Source, FileOrDir (Dir),
SymbolicPath)
import Distribution.Verbosity (Verbosity, normal)
type CabalFP = SymbolicPath Pkg (Dir Source)
defaultMainC2Hs :: IO ()
defaultMainC2Hs :: IO ()
defaultMainC2Hs = UserHooks -> IO ()
defaultMainWithHooks UserHooks
c2hsUserHooks
c2hsUserHooks :: UserHooks
c2hsUserHooks :: UserHooks
c2hsUserHooks = UserHooks
simpleUserHooks { buildHook = c2hsBuildHooks
, haddockHook = c2hsHaddockHooks
, replHook = c2hsReplHooks
}
c2hsBuildHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
c2hsBuildHooks :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
c2hsBuildHooks = \PackageDescription
pd LocalBuildInfo
lbi UserHooks
hooks BuildFlags
bf -> do
let v :: Verbosity
v = CommonSetupFlags -> Verbosity
getSetupVerbosity (BuildFlags -> CommonSetupFlags
buildCommonFlags BuildFlags
bf)
PackageDescription
pd' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> PackageDescription -> IO PackageDescription
mapPackageDescription (Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs Verbosity
v) PackageDescription
pd
UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
simpleUserHooks PackageDescription
pd' LocalBuildInfo
lbi UserHooks
hooks BuildFlags
bf
c2hsHaddockHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
c2hsHaddockHooks :: PackageDescription
-> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
c2hsHaddockHooks = \PackageDescription
pd LocalBuildInfo
lbi UserHooks
hooks HaddockFlags
hf -> do
let v :: Verbosity
v = CommonSetupFlags -> Verbosity
getSetupVerbosity (HaddockFlags -> CommonSetupFlags
haddockCommonFlags HaddockFlags
hf)
PackageDescription
pd' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> PackageDescription -> IO PackageDescription
mapPackageDescription (Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs Verbosity
v) PackageDescription
pd
UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> HaddockFlags
-> IO ()
haddockHook UserHooks
simpleUserHooks PackageDescription
pd' LocalBuildInfo
lbi UserHooks
hooks HaddockFlags
hf
c2hsReplHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
c2hsReplHooks :: PackageDescription
-> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
c2hsReplHooks = \PackageDescription
pd LocalBuildInfo
lbi UserHooks
hooks ReplFlags
rf [String]
ss -> do
let v :: Verbosity
v = CommonSetupFlags -> Verbosity
getSetupVerbosity (ReplFlags -> CommonSetupFlags
replCommonFlags ReplFlags
rf)
PackageDescription
pd' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> PackageDescription -> IO PackageDescription
mapPackageDescription (Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs Verbosity
v) PackageDescription
pd
UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> ReplFlags
-> [String]
-> IO ()
replHook UserHooks
simpleUserHooks PackageDescription
pd' LocalBuildInfo
lbi UserHooks
hooks ReplFlags
rf [String]
ss
getSetupVerbosity :: CommonSetupFlags -> Verbosity
getSetupVerbosity :: CommonSetupFlags -> Verbosity
getSetupVerbosity CommonSetupFlags { setupVerbosity :: CommonSetupFlags -> Flag Verbosity
setupVerbosity = Flag Verbosity
v } = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
v
mapPackageDescription :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> PackageDescription -> IO PackageDescription
mapPackageDescription :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> PackageDescription -> IO PackageDescription
mapPackageDescription [CabalFP] -> [ModuleName] -> IO [ModuleName]
f p :: PackageDescription
p@PackageDescription { library :: PackageDescription -> Maybe Library
library = Maybe Library
ml
, subLibraries :: PackageDescription -> [Library]
subLibraries = [Library]
ls
, executables :: PackageDescription -> [Executable]
executables = [Executable]
es
, foreignLibs :: PackageDescription -> [ForeignLib]
foreignLibs = [ForeignLib]
fs
, testSuites :: PackageDescription -> [TestSuite]
testSuites = [TestSuite]
ts
, benchmarks :: PackageDescription -> [Benchmark]
benchmarks = [Benchmark]
bs
} = do
Maybe Library
ml' <- (Library -> IO Library) -> Maybe Library -> IO (Maybe Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Library -> IO Library
mapLibrary [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) Maybe Library
ml
[Library]
ls' <- (Library -> IO Library) -> [Library] -> IO [Library]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Library -> IO Library
mapLibrary [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [Library]
ls
[Executable]
es' <- (Executable -> IO Executable) -> [Executable] -> IO [Executable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Executable -> IO Executable
mapExecutable [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [Executable]
es
[ForeignLib]
fs' <- (ForeignLib -> IO ForeignLib) -> [ForeignLib] -> IO [ForeignLib]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> ForeignLib -> IO ForeignLib
mapForeignLibrary [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [ForeignLib]
fs
[TestSuite]
ts' <- (TestSuite -> IO TestSuite) -> [TestSuite] -> IO [TestSuite]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> TestSuite -> IO TestSuite
mapTestSuite [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [TestSuite]
ts
[Benchmark]
bs' <- (Benchmark -> IO Benchmark) -> [Benchmark] -> IO [Benchmark]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Benchmark -> IO Benchmark
mapBenchmark [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [Benchmark]
bs
PackageDescription -> IO PackageDescription
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageDescription -> IO PackageDescription)
-> PackageDescription -> IO PackageDescription
forall a b. (a -> b) -> a -> b
$ PackageDescription
p { library = ml'
, subLibraries = ls'
, executables = es'
, foreignLibs = fs'
, testSuites = ts'
, benchmarks = bs'
}
mapLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Library -> IO Library
mapLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Library -> IO Library
mapLibrary [CabalFP] -> [ModuleName] -> IO [ModuleName]
f lib :: Library
lib@Library { exposedModules :: Library -> [ModuleName]
exposedModules = [ModuleName]
es, libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
bi } = do
let dirs :: [CabalFP]
dirs = BuildInfo -> [CabalFP]
hsSourceDirs BuildInfo
bi
om :: [ModuleName]
om = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
isOther :: ModuleName -> Bool
isOther = (ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
es)
[ModuleName]
newMods <- [CabalFP] -> [ModuleName] -> IO [ModuleName]
f [CabalFP]
dirs ([ModuleName]
es [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
om)
let om' :: [ModuleName]
om' = (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter ModuleName -> Bool
isOther [ModuleName]
newMods
bi' :: BuildInfo
bi' = BuildInfo
bi { otherModules = om' }
Library -> IO Library
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Library -> IO Library) -> Library -> IO Library
forall a b. (a -> b) -> a -> b
$ Library
lib { exposedModules = newMods, libBuildInfo = bi' }
mapBenchmark :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Benchmark -> IO Benchmark
mapBenchmark :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Benchmark -> IO Benchmark
mapBenchmark [CabalFP] -> [ModuleName] -> IO [ModuleName]
f b :: Benchmark
b@Benchmark { benchmarkBuildInfo :: Benchmark -> BuildInfo
benchmarkBuildInfo = BuildInfo
bi } = do
BuildInfo
bi' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> BuildInfo -> IO BuildInfo
mapBuildInfo [CabalFP] -> [ModuleName] -> IO [ModuleName]
f BuildInfo
bi
Benchmark -> IO Benchmark
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Benchmark -> IO Benchmark) -> Benchmark -> IO Benchmark
forall a b. (a -> b) -> a -> b
$ Benchmark
b { benchmarkBuildInfo = bi' }
mapExecutable :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> Executable -> IO Executable
mapExecutable :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Executable -> IO Executable
mapExecutable [CabalFP] -> [ModuleName] -> IO [ModuleName]
f e :: Executable
e@Executable { buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi } = do
BuildInfo
bi' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> BuildInfo -> IO BuildInfo
mapBuildInfo [CabalFP] -> [ModuleName] -> IO [ModuleName]
f BuildInfo
bi
Executable -> IO Executable
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Executable -> IO Executable) -> Executable -> IO Executable
forall a b. (a -> b) -> a -> b
$ Executable
e { buildInfo = bi' }
mapForeignLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> ForeignLib -> IO ForeignLib
mapForeignLibrary :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> ForeignLib -> IO ForeignLib
mapForeignLibrary [CabalFP] -> [ModuleName] -> IO [ModuleName]
f fl :: ForeignLib
fl@ForeignLib { foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi } = do
BuildInfo
bi' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> BuildInfo -> IO BuildInfo
mapBuildInfo [CabalFP] -> [ModuleName] -> IO [ModuleName]
f BuildInfo
bi
ForeignLib -> IO ForeignLib
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignLib -> IO ForeignLib) -> ForeignLib -> IO ForeignLib
forall a b. (a -> b) -> a -> b
$ ForeignLib
fl { foreignLibBuildInfo = bi' }
mapTestSuite :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> TestSuite -> IO TestSuite
mapTestSuite :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> TestSuite -> IO TestSuite
mapTestSuite [CabalFP] -> [ModuleName] -> IO [ModuleName]
f t :: TestSuite
t@TestSuite { testBuildInfo :: TestSuite -> BuildInfo
testBuildInfo = BuildInfo
bi } = do
BuildInfo
bi' <- ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> BuildInfo -> IO BuildInfo
mapBuildInfo [CabalFP] -> [ModuleName] -> IO [ModuleName]
f BuildInfo
bi
TestSuite -> IO TestSuite
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestSuite -> IO TestSuite) -> TestSuite -> IO TestSuite
forall a b. (a -> b) -> a -> b
$ TestSuite
t { testBuildInfo = bi' }
mapBuildInfo :: ([CabalFP] -> [ModuleName] -> IO [ModuleName]) -> BuildInfo -> IO BuildInfo
mapBuildInfo :: ([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> BuildInfo -> IO BuildInfo
mapBuildInfo [CabalFP] -> [ModuleName] -> IO [ModuleName]
f bi :: BuildInfo
bi@BuildInfo { otherModules :: BuildInfo -> [ModuleName]
otherModules = [ModuleName]
om, hsSourceDirs :: BuildInfo -> [CabalFP]
hsSourceDirs = [CabalFP]
dirs } = do
[ModuleName]
om' <- [CabalFP] -> [ModuleName] -> IO [ModuleName]
f [CabalFP]
dirs [ModuleName]
om
BuildInfo -> IO BuildInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildInfo -> IO BuildInfo) -> BuildInfo -> IO BuildInfo
forall a b. (a -> b) -> a -> b
$ BuildInfo
bi { otherModules = om' }