From 0ee840da444ab8b575c90841c32c3842e84e7ca0 Mon Sep 17 00:00:00 2001
From: Luite Stegeman <stegeman@gmail.com>
Date: Wed, 4 Apr 2012 03:42:25 +0200
Subject: [PATCH] use Cabal to determine location of ar'

---
 yesod/Devel.hs    | 41 +++++++++++++++++++++++++++++++----------
 yesod/GhcBuild.hs | 19 +++++++++----------
 2 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/yesod/Devel.hs b/yesod/Devel.hs
index 49b4de0f..c8afc71a 100644
--- a/yesod/Devel.hs
+++ b/yesod/Devel.hs
@@ -11,7 +11,11 @@ import qualified Distribution.Verbosity as D
 import qualified Distribution.PackageDescription.Parse as D
 import qualified Distribution.PackageDescription as D
 import qualified Distribution.ModuleName as D
+import qualified Distribution.Simple.Configure as D
+import qualified Distribution.Simple.Program as D
+import qualified Distribution.Compiler as D
 
+import           Control.Applicative ((<$>), (<*>))
 import           Control.Concurrent (forkIO, threadDelay)
 import qualified Control.Exception as Ex
 import           Control.Monad (forever, when, unless)
@@ -57,11 +61,12 @@ devel isCabalDev passThroughArgs = do
       cabal <- D.findPackageDesc "."
       gpd   <- D.readPackageDescription D.normal cabal
 
+      ldar <- lookupLdAr
       hsSourceDirs <- checkCabalFile gpd
 
       _<- rawSystem cmd args
 
-      mainLoop hsSourceDirs cabal
+      mainLoop hsSourceDirs cabal ldar
 
     _ <- getLine
     writeLock
@@ -88,12 +93,12 @@ devel isCabalDev passThroughArgs = do
             ]
     args = "configure":diffArgs ++ ["--disable-library-profiling" ]
 
-    mainLoop :: [FilePath] -> FilePath -> IO ()
-    mainLoop hsSourceDirs cabal = do
+    mainLoop :: [FilePath] -> FilePath -> (FilePath, FilePath) -> IO ()
+    mainLoop hsSourceDirs cabal ldar = do
        ghcVer <- ghcVersion
        _ <- rebuildCabal cmd
        pkgArgs <- ghcPackageArgs isCabalDev ghcVer
-       rebuild <- mkRebuild ghcVer cabal cmd
+       rebuild <- mkRebuild ghcVer cabal cmd ldar
        let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs
        forever $ do
            recompDeps hsSourceDirs
@@ -118,8 +123,8 @@ devel isCabalDev passThroughArgs = do
                    Ex.throwTo watchTid (userError "process finished")
            watchForChanges hsSourceDirs list
 
-mkRebuild :: String -> FilePath -> String -> IO (IO Bool)
-mkRebuild ghcVer cabalFile cabalCmd
+mkRebuild :: String -> FilePath -> String -> (FilePath, FilePath) -> IO (IO Bool)
+mkRebuild ghcVer cabalFile cabalCmd (ldPath, arPath)
   | GHC.cProjectVersion == ghcVer = do
       bf <- getBuildFlags
       return $ do
@@ -128,15 +133,15 @@ mkRebuild ghcVer cabalFile cabalCmd
         n3 <- cabalFile `isNewerThan` "dist/ldargs.txt"
         if n1 || n2 || n3
           then rebuildCabal cabalCmd
-          else rebuildGhc bf
+          else rebuildGhc bf ldPath arPath
   | otherwise = return $ do
                   putStrLn "WARNING: yesod is compiled with a different ghc version, falling back to cabal"
                   rebuildCabal cabalCmd
 
-rebuildGhc :: [Located String] -> IO Bool
-rebuildGhc bf = do
+rebuildGhc :: [Located String] -> FilePath -> FilePath -> IO Bool
+rebuildGhc bf ld ar = do
   putStrLn "Rebuilding application... (GHC API)"
-  buildPackage bf
+  buildPackage bf ld ar
 
 rebuildCabal :: String -> IO Bool
 rebuildCabal cmd = do
@@ -243,6 +248,22 @@ lookupDevelLib ct | found     = Just (D.condTreeData ct)
     isDevelLib (D.Var (D.Flag (D.FlagName f)), _, _) = f `elem` ["library-only", "devel"]
     isDevelLib _                                       = False
 
+-- location of `ld' and `ar' programs
+lookupLdAr :: IO (FilePath, FilePath)
+lookupLdAr = do 
+  mla <- lookupLdAr'
+  case mla of
+    Nothing -> failWith "Cannot determine location of `ar' or `ld' program"
+    Just la -> return la
+
+lookupLdAr' :: IO (Maybe (FilePath, FilePath))
+lookupLdAr' = do
+  (comp, pgmc) <- D.configCompiler (Just D.GHC) Nothing Nothing D.defaultProgramConfiguration D.silent
+  pgmc' <- D.configureAllKnownPrograms D.silent pgmc
+  return $ (,) <$> look D.ldProgram pgmc' <*> look D.arProgram pgmc'
+     where
+       look pgm pdb = fmap D.programPath (D.lookupProgram pgm pdb)
+
 -- | Acts like @rawSystem@, but filters out lines from the output that we're not interested in seeing.
 rawSystemFilter :: String -> [String] -> IO ExitCode
 rawSystemFilter command args = do
diff --git a/yesod/GhcBuild.hs b/yesod/GhcBuild.hs
index 1e610340..ac67626c 100644
--- a/yesod/GhcBuild.hs
+++ b/yesod/GhcBuild.hs
@@ -48,13 +48,13 @@ getBuildFlags = do
   (argv2, staticFlagWarnings) <- GHC.parseStaticFlags argv1'
   return argv2
 
-buildPackage :: [Located String] -> IO Bool
-buildPackage a = buildPackage' a `Ex.catch` \(e::Ex.SomeException) -> do
+buildPackage :: [Located String] -> FilePath -> FilePath -> IO Bool
+buildPackage a ld ar = buildPackage' a ld ar `Ex.catch` \(e::Ex.SomeException) -> do
   putStrLn ("exception building package: " ++ show e)
   return False
 
-buildPackage' :: [Located String] -> IO Bool
-buildPackage' argv2 = do
+buildPackage' :: [Located String] -> FilePath -> FilePath -> IO Bool
+buildPackage' argv2 ld ar = do
   (mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
   GHC.runGhc (Just libdir) $ do
     dflags0 <- GHC.getSessionDynFlags
@@ -93,15 +93,14 @@ buildPackage' argv2 = do
     ok_flag <- GHC.load GHC.LoadAllTargets
     if GHC.failed ok_flag
       then return False
-      else liftIO linkPkg >> return True
+      else liftIO (linkPkg ld ar) >> return True
 
--- fixme, find default ar and ld versions
-linkPkg :: IO ()
-linkPkg = do
+linkPkg :: FilePath -> FilePath -> IO ()
+linkPkg ld ar = do
   arargs <- fmap read $ readFile "dist/arargs.txt"
-  rawSystem "ar" arargs
+  rawSystem ar arargs
   ldargs <- fmap read $ readFile "dist/ldargs.txt"
-  rawSystem "ld" ldargs
+  rawSystem ld ldargs
   return ()
 
 --------------------------------------------------------------------------------------------