module Shaker.SourceHelper(
CompileFile(..)
,mergeCompileInputsSources
,constructCompileFileList
,setAllHsFilesAsTargets
,removeFileWithMain
,removeFileWithTemplateHaskell
,fillCompileInputWithStandardTarget
,initializeGhc
,ghcCompile
,getFullCompileCompileInput
,checkUnchangedSources
,isModuleNeedCompilation
)
where
import GHC
import Data.List
import Shaker.Io
import Shaker.Type
import Control.Monad.Reader(ask, asks, lift, runReader, Reader)
import LazyUniqFM
import MkIface
import HscTypes
import Linker
import System.Directory
type CompileR = Reader [CompileFile]
data CompileFile = CompileFile {
cfFp :: FilePath
,cfHasMain :: Bool
,cfHasTH :: Bool
} deriving Show
constructCompileFileList :: CompileInput -> IO [CompileFile]
constructCompileFileList cpIn = do
files <- recurseMultipleListFiles fli
mapM constructCompileFile $ nub files
where fli = getFileListenInfoForCompileInput cpIn
constructCompileFile :: FilePath -> IO CompileFile
constructCompileFile fp = do
hasMain <- isFileContainingMain fp
hasTH <- isFileContainingTH fp
return $ CompileFile fp hasMain hasTH
mergeCompileInputsSources :: [CompileInput] -> CompileInput
mergeCompileInputsSources [] = defaultCompileInput
mergeCompileInputsSources cplInps@(cpIn:_) = do
let srcDirs = nub $ concatMap cfSourceDirs cplInps
let mergedDynFlags = foldl1 (.) (map cfDynFlags cplInps)
cpIn {cfDynFlags = mergedDynFlags, cfSourceDirs = srcDirs, cfDescription ="Full compilation"}
setAllHsFilesAsTargets :: CompileInput -> CompileR CompileInput
setAllHsFilesAsTargets cpIn = do
files <- ask
return cpIn {cfTargetFiles = map cfFp files }
configureDynFlagsWithCompileInput :: CompileInput -> DynFlags -> DynFlags
configureDynFlagsWithCompileInput cpIn dflags = dflags{
importPaths = sourceDirs
,objectDir = Just compileTarget
,hiDir = Just compileTarget
}
where compileTarget = cfCompileTarget cpIn
sourceDirs = cfSourceDirs cpIn
getFileListenInfoForCompileInput :: CompileInput -> [FileListenInfo]
getFileListenInfoForCompileInput cpIn =
map (\a -> FileListenInfo a defaultExclude defaultHaskellPatterns) (cfSourceDirs cpIn)
removeFileWithTemplateHaskell :: CompileInput ->CompileR CompileInput
removeFileWithTemplateHaskell = removeFileWithPredicate cfHasTH
removeFileWithMain :: CompileInput -> CompileR CompileInput
removeFileWithMain = removeFileWithPredicate cfHasMain
removeFileWithPredicate :: (CompileFile -> Bool) -> CompileInput -> CompileR CompileInput
removeFileWithPredicate predicate cpIn = do
cpFl <- ask
let toRemove = map cfFp $ filter predicate cpFl
return $ cpIn {cfTargetFiles = targets \\ toRemove}
where targets = cfTargetFiles cpIn
fillCompileInputWithStandardTarget :: CompileInput -> CompileR CompileInput
fillCompileInputWithStandardTarget cpIn = setAllHsFilesAsTargets cpIn >>= removeFileWithMain >>=removeFileWithTemplateHaskell
ghcCompile :: GhcMonad m => CompileInput -> m SuccessFlag
ghcCompile cpIn = do
initializeGhc cpIn
dflags <- getSessionDynFlags
liftIO $ unload dflags []
load LoadAllTargets
getFullCompileCompileInput :: Shaker IO (CompileInput)
getFullCompileCompileInput = do
cpList <- asks compileInputs
let cpIn = mergeCompileInputsSources cpList
cfFlList <- lift $ constructCompileFileList cpIn
return $ runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain ) cfFlList
initializeGhc :: GhcMonad m => CompileInput -> m ()
initializeGhc cpIn@(CompileInput _ _ _ procFlags strflags targetFiles) = do
modifySession (\h -> h {hsc_HPT = emptyHomePackageTable} )
dflags <- getSessionDynFlags
(newFlags,_,_) <- parseDynamicFlags dflags (map noLoc strflags)
let chgdFlags = configureDynFlagsWithCompileInput cpIn newFlags
_ <- setSessionDynFlags $ procFlags chgdFlags
target <- mapM (`guessTarget` Nothing) targetFiles
setTargets target
isModuleNeedCompilation :: (GhcMonad m) =>
[FilePath]
-> ModSummary
-> m Bool
isModuleNeedCompilation modFiles ms = do
hsc_env <- getSession
source_unchanged <- liftIO $ checkUnchangedSources modFiles ms
(recom, mb_md_iface ) <- liftIO $ checkOldIface hsc_env ms source_unchanged Nothing
case mb_md_iface of
Just md_iface -> do
let module_name = (moduleName . mi_module) md_iface
the_hpt = hsc_HPT hsc_env
home_mod_info = HomeModInfo {hm_iface = md_iface, hm_details = emptyModDetails, hm_linkable = Nothing }
newHpt = addToUFM the_hpt module_name home_mod_info
modifySession (\h -> h {hsc_HPT = newHpt} )
return recom
_ -> return True
checkUnchangedSources :: [FilePath] -> ModSummary -> IO Bool
checkUnchangedSources fps ms = checkUnchangedSources' fps $ (ml_hs_file . ms_location) ms
checkUnchangedSources' :: [FilePath] -> Maybe FilePath -> IO Bool
checkUnchangedSources' _ Nothing = return False
checkUnchangedSources' modifiedFiles (Just src) = do
canonical_modFiles <- liftIO $ mapM canonicalizePath modifiedFiles
cano_src <- canonicalizePath src
return $ cano_src `notElem` canonical_modFiles