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 (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 :: IO ()
defaultMainC2Hs = UserHooks -> IO ()
defaultMainWithHooks UserHooks
c2hsUserHooks
c2hsUserHooks :: UserHooks
c2hsUserHooks :: UserHooks
c2hsUserHooks = UserHooks
simpleUserHooks { buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
c2hsBuildHooks
, haddockHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
haddockHook = PackageDescription
-> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
c2hsHaddockHooks
, replHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
replHook = PackageDescription
-> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
c2hsReplHooks
}
reorderC2Hs' :: Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs' :: Verbosity -> [CabalFP] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs' Verbosity
v [CabalFP]
fps = Verbosity -> [String] -> [ModuleName] -> IO [ModuleName]
reorderC2Hs Verbosity
v ((CabalFP -> String) -> [CabalFP] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalFP -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath [CabalFP]
fps)
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 = BuildFlags -> Verbosity
getVerbosity 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 = HaddockFlags -> Verbosity
getHaddockVerbosity 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 = ReplFlags -> Verbosity
getReplVerbosity 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
getHaddockVerbosity :: HaddockFlags -> Verbosity
getHaddockVerbosity :: HaddockFlags -> Verbosity
getHaddockVerbosity HaddockFlags { haddockVerbosity :: HaddockFlags -> Flag Verbosity
haddockVerbosity = Flag Verbosity
v } = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
v
getVerbosity :: BuildFlags -> Verbosity
getVerbosity :: BuildFlags -> Verbosity
getVerbosity BuildFlags { buildVerbosity :: BuildFlags -> Flag Verbosity
buildVerbosity = Flag Verbosity
v } = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal Flag Verbosity
v
getReplVerbosity :: ReplFlags -> Verbosity
getReplVerbosity :: ReplFlags -> Verbosity
getReplVerbosity ReplFlags { replVerbosity :: ReplFlags -> Flag Verbosity
replVerbosity = 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)
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)
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)
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)
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)
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)
traverse (([CabalFP] -> [ModuleName] -> IO [ModuleName])
-> Benchmark -> IO Benchmark
mapBenchmark [CabalFP] -> [ModuleName] -> IO [ModuleName]
f) [Benchmark]
bs
PackageDescription -> IO PackageDescription
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 :: Maybe Library
library = Maybe Library
ml'
, subLibraries :: [Library]
subLibraries = [Library]
ls'
, executables :: [Executable]
executables = [Executable]
es'
, foreignLibs :: [ForeignLib]
foreignLibs = [ForeignLib]
fs'
, testSuites :: [TestSuite]
testSuites = [TestSuite]
ts'
, benchmarks :: [Benchmark]
benchmarks = [Benchmark]
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 :: [ModuleName]
otherModules = [ModuleName]
om' }
Library -> IO Library
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 :: [ModuleName]
exposedModules = [ModuleName]
newMods, libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Benchmark -> IO Benchmark) -> Benchmark -> IO Benchmark
forall a b. (a -> b) -> a -> b
$ Benchmark
b { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Executable -> IO Executable) -> Executable -> IO Executable
forall a b. (a -> b) -> a -> b
$ Executable
e { buildInfo :: BuildInfo
buildInfo = 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 (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignLib -> IO ForeignLib) -> ForeignLib -> IO ForeignLib
forall a b. (a -> b) -> a -> b
$ ForeignLib
fl { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = BuildInfo
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 (f :: * -> *) a. Applicative f => a -> f a
pure (TestSuite -> IO TestSuite) -> TestSuite -> IO TestSuite
forall a b. (a -> b) -> a -> b
$ TestSuite
t { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
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 (f :: * -> *) a. Applicative f => a -> f a
pure (BuildInfo -> IO BuildInfo) -> BuildInfo -> IO BuildInfo
forall a b. (a -> b) -> a -> b
$ BuildInfo
bi { otherModules :: [ModuleName]
otherModules = [ModuleName]
om' }