Target.hs

-- | Set the files as targets and load them.
loadTargets :: IOish m => [GHCOption] -> [FilePath] -> Maybe (GHC.Hooks -> GHC.Hooks) -> GmlT m ()
loadTargets opts targetStrs mUpdateHooks = do
    crdl <- cradle
    let loadGhcEnv = shouldLoadGhcEnvironment crdl
    targets' <-
        withLightHscEnv loadGhcEnv opts $ \env ->
                liftM (nubBy ((==) `on` targetId))
                  (mapM ((`guessTarget` Nothing) >=> mapFile env) targetStrs)
              >>= mapM relativize

    let targets = map (\t -> t { targetAllowObjCode = False }) targets'
        targetFileNames = concatMap filePathFromTarget targets

    gmLog GmDebug "loadTargets" $
          text "Loading" <+>: fsep (map (text . showTargetId) targets)


    let filterModSums = isJust mUpdateHooks
    gmLog GmDebug "loadTargets" $
          text "filterModSums" <+>: text (show filterModSums)

    setTargets targets

    when filterModSums $ updateModuleGraph setDynFlagsRecompile targetFileNames

    mg <- depanal [] False

    let interp = needsHscInterpreted mg
    target <- hscTarget <$> getSessionDynFlags
    when (interp && target /= HscInterpreted) $ do
      let
        setHooks :: DynFlags -> DynFlags
        setHooks df = df { GHC.hooks = (fromMaybe id mUpdateHooks) (GHC.hooks df) }
      _ <- setSessionDynFlags . setHscInterpreted . setHooks =<< getSessionDynFlags
      gmLog GmInfo "loadTargets" $ text "Target needs interpeter, switching to LinkInMemory/HscInterpreted. Perfectly normal if anything is using TemplateHaskell, QuasiQuotes or PatternSynonyms."

    when filterModSums $ updateModuleGraph setDynFlagsRecompile targetFileNames

    target' <- hscTarget <$> getSessionDynFlags

    dynFlags' <- getSessionDynFlags
    dynFlags <- liftIO $ withLightHscEnv loadGhcEnv opts $ \env ->
          DynamicLoading.initializePlugins env dynFlags'
    _ <- setSessionDynFlags dynFlags
    
    case target' of
      HscNothing -> do
        void $ load LoadAllTargets
#if __GLASGOW_HASKELL__ >= 804
        forM_ (mgModSummaries mg) $
#else
        forM_ mg $
#endif
          handleSourceError (gmLog GmDebug "loadTargets" . text . show)
          . void . (parseModule >=> typecheckModule >=> desugarModule)
      HscInterpreted -> do
        void $ load LoadAllTargets
      _ -> error ("loadTargets: unsupported hscTarget")

    when filterModSums $ updateModuleGraph unSetDynFlagsRecompile targetFileNames

    gmLog GmDebug "loadTargets" $ text "Loading done"

  where
    relativize (Target (TargetFile filePath phase) taoc src) = do
      crdl <- cradle
      let tid = TargetFile relativeFilePath phase
          relativeFilePath = makeRelative (cradleRootDir crdl) filePath
      return $ Target tid taoc src
    relativize tgt = return tgt

    showTargetId (Target (TargetModule s) _ _) = moduleNameString s
    showTargetId (Target (TargetFile s _) _ _) = s

    filePathFromTarget (Target (TargetModule _) _ _) = []
    filePathFromTarget (Target (TargetFile s _) _ _) = [s]

    updateModuleGraph :: (GhcMonad m, GmState m, GmEnv m,
                          MonadIO m, GmLog m, GmOut m)
                      => (DynFlags -> DynFlags) -> [FilePath] -> m ()
    updateModuleGraph df fps = do
      let
        fpSet = Set.fromList fps
        updateHooks df = df { GHC.hooks = (fromMaybe id mUpdateHooks) (GHC.hooks df)}
        mustRecompile ms = case (ml_hs_file . ms_location)  ms of
          Nothing -> ms
          Just f -> if Set.member f fpSet
                      then ms {ms_hspp_opts = (df . updateHooks) (ms_hspp_opts ms)}
                      else ms
#if __GLASGOW_HASKELL__ >= 804
        update s = s {hsc_mod_graph = mkModuleGraph $ map mustRecompile (mgModSummaries $ hsc_mod_graph s)}
#else
        update s = s {hsc_mod_graph = map mustRecompile (hsc_mod_graph s)}
#endif
      G.modifySession update

    setDynFlagsRecompile :: DynFlags -> DynFlags
    setDynFlagsRecompile df = gopt_set df Opt_ForceRecomp

    unSetDynFlagsRecompile :: DynFlags -> DynFlags
    unSetDynFlagsRecompile df = gopt_unset df Opt_ForceRecomp