module Shaker.CabalInfo(
defaultCabalInput
,applyPreprocessSources
)
where
import Control.Arrow
import Control.Monad.Reader
import Data.List(nub,isSuffixOf, find, isPrefixOf)
import Data.Maybe
import Data.Monoid
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.Package (PackageName(PackageName), pkgName)
import Distribution.Simple.Compiler (PackageDB(..))
import Distribution.Simple.Configure (maybeGetPersistBuildConfig, configure, writePersistBuildConfig, getInstalledPackages)
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils
import Distribution.Verbosity
import DynFlags( DynFlags, verbosity, ghcLink, packageFlags, importPaths ,PackageFlag (ExposePackageId) ,GhcLink (NoLink))
import Shaker.CabalInterface
import Shaker.Config
import Shaker.GhcInterface
import Shaker.Io
import Shaker.ModuleData
import Shaker.Type
import System.Directory (doesFileExist)
import System.FilePath ( (</>))
defaultCabalInput :: IO ShakerInput
defaultCabalInput = readConf
>>= \lbi -> generateAutogenFiles lbi
>> localBuildInfoToShakerInput lbi
>>= checkInvalidMain
>>= fillModuleData
>>= fillPackageIndex
readConf :: IO LocalBuildInfo
readConf = maybeGetPersistBuildConfig "dist" >>= \my_lbi ->
case my_lbi of
Just lbi -> return lbi
Nothing -> callConfigure
callConfigure :: IO LocalBuildInfo
callConfigure = do
genericPackageDescription <- defaultPackageDesc silent >>= readPackageDescription silent
lbi <- configure (genericPackageDescription ,emptyHookedBuildInfo) (defaultConfigFlags defaultProgramConfiguration)
writePersistBuildConfig "dist" lbi
return lbi
localBuildInfoToShakerInput :: LocalBuildInfo -> IO ShakerInput
localBuildInfoToShakerInput lbi = do
defInput <- defaultInputInitialized
let cplInputs = localBuildInfoToCompileInputs lbi
let listenerInput = compileInputsToListenerInput cplInputs
return defInput {
shakerCompileInputs = cplInputs
,shakerListenerInput = listenerInput
,shakerLocalBuildInfo = lbi
}
compileInputsToListenerInput :: [CompileInput] -> ListenerInput
compileInputsToListenerInput cplInputs = mempty {
listenerInputFiles = nub $ map (\a -> FileListenInfo a defaultExclude defaultHaskellPatterns) concatSources
}
where concatSources = concatMap compileInputSourceDirs cplInputs
localBuildInfoToCompileInputs :: LocalBuildInfo -> [CompileInput]
localBuildInfoToCompileInputs lbi = executableAndLibToCompileInput lbi libraryTuple executablesTuples
where pkgDescription = localPkgDescr lbi
libraryTuple = library pkgDescription >>= \a -> libraryConfig lbi >>= \b -> return (a,b)
executablesTuples = mapMaybe ( \ (name, comp) -> find (\ex -> exeName ex == name) listExecutables >>= \e -> return (e, comp) ) listConfigs
listExecutables = executables pkgDescription
listConfigs = executableConfigs lbi
executableAndLibToCompileInput :: LocalBuildInfo -> Maybe (Library, ComponentLocalBuildInfo) -> [(Executable,ComponentLocalBuildInfo)] -> [CompileInput]
executableAndLibToCompileInput lbi Nothing exes = map (executableToCompileInput lbi) exes
executableAndLibToCompileInput lbi (Just lib) exes = libraryToCompileInput lbi lib : map (executableToCompileInput lbi) exes
executableToCompileInput :: LocalBuildInfo -> (Executable, ComponentLocalBuildInfo) -> CompileInput
executableToCompileInput lbi (executable, componentLocalBuildInfo) = mempty {
compileInputSourceDirs = mySourceDir
,compileInputCommandLineFlags = getCompileFlagsForExecutable lbi executable componentLocalBuildInfo
,compileInputTargetFiles = map (</> modulePath executable ) mySourceDir
,compileInputDynFlags = toDynFlags mySourceDir (getLibDependencies componentLocalBuildInfo)
}
where bldInfo = buildInfo executable
mySourceDir = "dist/build/autogen" : hsSourceDirs bldInfo
libraryToCompileInput :: LocalBuildInfo -> (Library, ComponentLocalBuildInfo) -> CompileInput
libraryToCompileInput lbi (lib, componentLocalBuildInfo) = mempty {
compileInputSourceDirs = mySourceDir
,compileInputCommandLineFlags = getCompileFlagsForLibrary lbi lib componentLocalBuildInfo
,compileInputTargetFiles = myModules
,compileInputDynFlags = toDynFlags mySourceDir (getLibDependencies componentLocalBuildInfo)
}
where bldInfo = libBuildInfo lib
myModules = map convertModuleNameToString $ exposedModules lib
mySourceDir = "dist/build/autogen": hsSourceDirs bldInfo
toDynFlags :: [String] -> [String] -> DynFlags -> DynFlags
toDynFlags sourceDirs packagesToExpose dnFlags = dnFlags {
importPaths = nub $ oldImportPaths ++ sourceDirs
,verbosity = 1
,ghcLink = NoLink
,packageFlags = nub $ map ExposePackageId packagesToExpose ++ oldPackageFlags
}
where oldPackageFlags = packageFlags dnFlags
oldImportPaths = importPaths dnFlags
getLibDependencies :: ComponentLocalBuildInfo -> [String]
getLibDependencies =
componentPackageDeps
>>> map (fst >>> installedPackageIdString )
convertModuleNameToString :: ModuleName -> String
convertModuleNameToString modName
| null modArr = ""
| otherwise = foldr1 (\w s -> w ++ '.':s) modArr
where modArr = components modName
checkInvalidMain :: ShakerInput -> IO ShakerInput
checkInvalidMain shIn = mapM checkInvalidMain' (shakerCompileInputs shIn) >>= \newCplInp ->
return $ shIn {shakerCompileInputs = newCplInp }
checkInvalidMain' :: CompileInput -> IO CompileInput
checkInvalidMain' cplInput
| any (".hs" `isSuffixOf`) oldTargets = do
newTargets <- filterM doesFileExist oldTargets
return cplInput {compileInputTargetFiles = newTargets}
| otherwise = return cplInput
where oldTargets = compileInputTargetFiles cplInput
exposeNeededPackages :: LocalBuildInfo -> ShakerInput -> IO ShakerInput
exposeNeededPackages lbi shIn = do
listPackages <- runReaderT getListNeededPackages shIn
putStrLn $ "Exposing packages " ++ show listPackages
let packageFlagsToAdd = map ExposePackageId $ filter ( \ name -> not $ currentPackage `isPrefixOf` name ) listPackages
let oldListenerInput = shakerListenerInput shIn
let listenerInputFilesToMerge = mempty
let newCpIns = map ( \a -> mappend a $ mempty { compileInputDynFlags = addPackageToDynFlags packageFlagsToAdd } ) (shakerCompileInputs shIn)
let newListFileListenInfo = map ( `mappend` listenerInputFilesToMerge) (listenerInputFiles oldListenerInput )
let newListenerInput = oldListenerInput { listenerInputFiles = newListFileListenInfo }
return $ shIn {shakerCompileInputs = newCpIns, shakerListenerInput= newListenerInput }
where addPackageToDynFlags packageFlagToAdd dynFlags = dynFlags {
packageFlags = packageFlags dynFlags ++ packageFlagToAdd
}
currentPackage = localPkgDescr >>> package >>> pkgName >>> unPackageName $ lbi
unPackageName (PackageName v) = v
fillPackageIndex :: ShakerInput -> IO ShakerInput
fillPackageIndex shIn = do
pkgIndex <- getInstalledPackages normal lbi_compiler [GlobalPackageDB] lbi_programConfiguration
return shIn { shakerPackageIndex = pkgIndex }
where lbi_compiler = shakerLocalBuildInfo >>> compiler $ shIn
lbi_programConfiguration = shakerLocalBuildInfo >>> withPrograms $ shIn