commercialhaskell · mgsloan · Nov 27, 2016 · Oct 31, 2016 · Nov 22, 2016 · Nov 22, 2016
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -79,6 +79,9 @@ Other enhancements:
   [#2235](https://github.com/commercialhaskell/stack/issues/2235)
 * Replace enclosed-exceptions with safe-exceptions.
   [#2768](https://github.com/commercialhaskell/stack/issues/2768)
+* `stack build` and related commands now allow the user to disable debug symbol stripping
+  with new `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping` flags, 
+  closing [#877](https://github.com/commercialhaskell/stack/issues/877).
 
 Bug fixes:
 

diff --git a/doc/GUIDE.md b/doc/GUIDE.md
@@ -2105,10 +2105,11 @@ but adds the `+RTS -xc` runtime option.
 
 ### DWARF
 
-`stack` currently doesn't support debugging and profiling with
-[DWARF information](https://ghc.haskell.org/trac/ghc/wiki/DWARF)
-as it strips executables automatically. This may change in the future (see
-[#877](https://github.com/commercialhaskell/stack/issues/877)).
+`stack` now supports debugging and profiling with
+[DWARF information](https://ghc.haskell.org/trac/ghc/wiki/DWARF),
+using the `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping`
+flags to disable the default behavior of removing such information from compiled
+libraries and executables.
 
 ### Further reading
 

diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs
@@ -94,6 +94,7 @@ build :: (StackM env m, HasEnvConfig env, MonadBaseUnlift IO m)
 build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
     bopts <- asks (configBuild . getConfig)
     let profiling = boptsLibProfile bopts || boptsExeProfile bopts
+    let symbols = boptsLibStrip bopts || boptsExeStrip bopts
     menv <- getMinimalEnvOverride
 
     (targets, mbp, locals, extraToBuild, extraDeps, sourceMap) <- loadSourceMapFull NeedTargets boptsCli
@@ -109,7 +110,8 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
         getInstalled menv
                      GetInstalledOpts
                          { getInstalledProfiling = profiling
-                         , getInstalledHaddock   = shouldHaddockDeps bopts }
+                         , getInstalledHaddock   = shouldHaddockDeps bopts
+                         , getInstalledSymbols   = symbols }
                      sourceMap
 
     warnMissingExtraDeps installedMap extraDeps

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -150,7 +150,7 @@ constructPlan :: forall env m. (StackM env m, HasEnvConfig env)
               -> BaseConfigOpts
               -> [LocalPackage]
               -> Set PackageName -- ^ additional packages that must be built
-              -> [DumpPackage () ()] -- ^ locally registered
+              -> [DumpPackage () () ()] -- ^ locally registered
               -> (PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) -- ^ load upstream package
               -> SourceMap
               -> InstalledMap

diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
@@ -226,9 +226,9 @@ data ExecuteEnv = ExecuteEnv
     , eeWanted         :: !(Set PackageName)
     , eeLocals         :: ![LocalPackage]
     , eeGlobalDB       :: !(Path Abs Dir)
-    , eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () ()))
-    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () ())))
-    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId (DumpPackage () ())))
+    , eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () () ()))
+    , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () () ())))
+    , eeLocalDumpPkgs  :: !(TVar (Map GhcPkgId (DumpPackage () () ())))
     , eeLogFiles       :: !(TChan (Path Abs Dir, Path Abs File))
     }
 
@@ -326,9 +326,9 @@ withExecuteEnv :: (StackM env m, HasEnvConfig env)
                -> BuildOptsCLI
                -> BaseConfigOpts
                -> [LocalPackage]
-               -> [DumpPackage () ()] -- ^ global packages
-               -> [DumpPackage () ()] -- ^ snapshot packages
-               -> [DumpPackage () ()] -- ^ local packages
+               -> [DumpPackage () () ()] -- ^ global packages
+               -> [DumpPackage () () ()] -- ^ snapshot packages
+               -> [DumpPackage () () ()] -- ^ local packages
                -> (ExecuteEnv -> m a)
                -> m a
 withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages inner = do
@@ -443,9 +443,9 @@ executePlan :: (StackM env m, HasEnvConfig env)
             -> BuildOptsCLI
             -> BaseConfigOpts
             -> [LocalPackage]
-            -> [DumpPackage () ()] -- ^ global packages
-            -> [DumpPackage () ()] -- ^ snapshot packages
-            -> [DumpPackage () ()] -- ^ local packages
+            -> [DumpPackage () () ()] -- ^ global packages
+            -> [DumpPackage () () ()] -- ^ snapshot packages
+            -> [DumpPackage () () ()] -- ^ local packages
             -> InstalledMap
             -> Map PackageName SimpleTarget
             -> Plan
@@ -1641,7 +1641,7 @@ taskComponents task =
 --
 -- * https://github.com/commercialhaskell/stack/issues/949
 addGlobalPackages :: Map PackageIdentifier GhcPkgId -- ^ dependencies of the package
-                  -> [DumpPackage () ()] -- ^ global packages
+                  -> [DumpPackage () () ()] -- ^ global packages
                   -> Set GhcPkgId
 addGlobalPackages deps globals0 =
     res

diff --git a/src/Stack/Build/Haddock.hs b/src/Stack/Build/Haddock.hs
@@ -122,7 +122,7 @@ generateLocalHaddockIndex
     => EnvOverride
     -> WhichCompiler
     -> BaseConfigOpts
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Local package dump
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Local package dump
     -> [LocalPackage]
     -> m ()
 generateLocalHaddockIndex envOverride wc bco localDumpPkgs locals = do
@@ -148,9 +148,9 @@ generateDepsHaddockIndex
     => EnvOverride
     -> WhichCompiler
     -> BaseConfigOpts
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Global dump information
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Snapshot dump information
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Local dump information
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Global dump information
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Snapshot dump information
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Local dump information
     -> [LocalPackage]
     -> m ()
 generateDepsHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs localDumpPkgs locals = do
@@ -193,8 +193,8 @@ generateSnapHaddockIndex
     => EnvOverride
     -> WhichCompiler
     -> BaseConfigOpts
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Global package dump
-    -> Map GhcPkgId (DumpPackage () ())  -- ^ Snapshot package dump
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Global package dump
+    -> Map GhcPkgId (DumpPackage () () ())  -- ^ Snapshot package dump
     -> m ()
 generateSnapHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs =
     generateHaddockIndex
@@ -213,7 +213,7 @@ generateHaddockIndex
     -> EnvOverride
     -> WhichCompiler
     -> HaddockOpts
-    -> [DumpPackage () ()]
+    -> [DumpPackage () () ()]
     -> FilePath
     -> Path Abs Dir
     -> m ()
@@ -241,7 +241,7 @@ generateHaddockIndex descr envOverride wc hdopts dumpPackages docRelFP destDir =
                  ["--gen-contents", "--gen-index"] ++
                  [x | (xs,_,_,_) <- interfaceOpts, x <- xs])
   where
-    toInterfaceOpt :: DumpPackage a b -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))
+    toInterfaceOpt :: DumpPackage a b c -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File))
     toInterfaceOpt DumpPackage {..} =
         case dpHaddockInterfaces of
             [] -> return Nothing
@@ -294,8 +294,8 @@ generateHaddockIndex descr envOverride wc hdopts dumpPackages docRelFP destDir =
 
 -- | Find first DumpPackage matching the GhcPkgId
 lookupDumpPackage :: GhcPkgId
-                  -> [Map GhcPkgId (DumpPackage () ())]
-                  -> Maybe (DumpPackage () ())
+                  -> [Map GhcPkgId (DumpPackage () () ())]
+                  -> Maybe (DumpPackage () () ())
 lookupDumpPackage ghcPkgId dumpPkgs =
     listToMaybe $ mapMaybe (Map.lookup ghcPkgId) dumpPkgs
 

diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TemplateHaskell       #-}
 -- Determine which packages are already installed
 module Stack.Build.Installed
@@ -52,6 +52,8 @@ data GetInstalledOpts = GetInstalledOpts
       -- ^ Require profiling libraries?
     , getInstalledHaddock   :: !Bool
       -- ^ Require haddocks?
+    , getInstalledSymbols   :: !Bool
+      -- ^ Require debugging symbols?
     }
 
 -- | Returns the new InstalledMap and all of the locally registered packages.
@@ -60,9 +62,9 @@ getInstalled :: (StackM env m, HasEnvConfig env, PackageInstallInfo pii)
              -> GetInstalledOpts
              -> Map PackageName pii -- ^ does not contain any installed information
              -> m ( InstalledMap
-                  , [DumpPackage () ()] -- globally installed
-                  , [DumpPackage () ()] -- snapshot installed
-                  , [DumpPackage () ()] -- locally installed
+                  , [DumpPackage () () ()] -- globally installed
+                  , [DumpPackage () () ()] -- snapshot installed
+                  , [DumpPackage () () ()] -- locally installed
                   )
 getInstalled menv opts sourceMap = do
     $logDebug "Finding out which packages are already installed"
@@ -132,11 +134,12 @@ loadDatabase :: (StackM env m, HasEnvConfig env, PackageInstallInfo pii)
              -> Map PackageName pii -- ^ to determine which installed things we should include
              -> Maybe (InstalledPackageLocation, Path Abs Dir) -- ^ package database, Nothing for global
              -> [LoadHelper] -- ^ from parent databases
-             -> m ([LoadHelper], [DumpPackage () ()])
+             -> m ([LoadHelper], [DumpPackage () () ()])
 loadDatabase menv opts mcache sourceMap mdb lhs0 = do
     wc <- getWhichCompiler
+    ver <- asks (bcWantedCompiler . getBuildConfig)
     (lhs1', dps) <- ghcPkgDump menv wc (fmap snd (maybeToList mdb))
-                $ conduitDumpPackage =$ sink
+                $ conduitDumpPackage =$ sink ver
     let ghcjsHack = wc == Ghcjs && isNothing mdb
     lhs1 <- mapMaybeM (processLoadResult mdb ghcjsHack) lhs1'
     let lhs = pruneDeps
@@ -159,13 +162,20 @@ loadDatabase menv opts mcache sourceMap mdb lhs0 = do
             -- Just an optimization to avoid calculating the haddock
             -- values when they aren't necessary
             _ -> CL.map (\dp -> dp { dpHaddock = False })
+    conduitSymbolsCache ver =
+        case mcache of
+            Just cache | getInstalledSymbols opts -> addSymbols cache ver
+            -- Just an optimization to avoid calculating the debugging
+            -- symbol values when they aren't necessary
+            _ -> CL.map (\dp -> dp { dpSymbols = False })
     mloc = fmap fst mdb
-    sinkDP = conduitProfilingCache
-          =$ conduitHaddockCache
-          =$ CL.map (isAllowed opts mcache sourceMap mloc &&& toLoadHelper mloc)
-          =$ CL.consume
-    sink = getZipSink $ (,)
-        <$> ZipSink sinkDP
+    sinkDP ver = conduitProfilingCache
+               =$ conduitHaddockCache
+               =$ conduitSymbolsCache ver
+               =$ CL.map (isAllowed opts mcache sourceMap mloc &&& toLoadHelper mloc)
+               =$ CL.consume
+    sink ver = getZipSink $ (,)
+        <$> ZipSink (sinkDP ver)
         <*> ZipSink CL.consume
 
 processLoadResult :: MonadLogger m
@@ -198,6 +208,7 @@ processLoadResult mdb _ (reason, lh) = do
             Allowed -> " the impossible?!?!"
             NeedsProfiling -> " it needing profiling."
             NeedsHaddock -> " it needing haddocks."
+            NeedsSymbols -> " it needing debugging symbols."
             UnknownPkg -> " it being unknown to the resolver / extra-deps."
             WrongLocation mloc loc -> " wrong location: " <> T.pack (show (mloc, loc))
             WrongVersion actual wanted -> T.concat
@@ -213,6 +224,7 @@ data Allowed
     = Allowed
     | NeedsProfiling
     | NeedsHaddock
+    | NeedsSymbols
     | UnknownPkg
     | WrongLocation (Maybe InstalledPackageLocation) InstallLocation
     | WrongVersion Version Version
@@ -226,13 +238,15 @@ isAllowed :: PackageInstallInfo pii
           -> Maybe InstalledCache
           -> Map PackageName pii
           -> Maybe InstalledPackageLocation
-          -> DumpPackage Bool Bool
+          -> DumpPackage Bool Bool Bool
           -> Allowed
 isAllowed opts mcache sourceMap mloc dp
     -- Check that it can do profiling if necessary
     | getInstalledProfiling opts && isJust mcache && not (dpProfiling dp) = NeedsProfiling
     -- Check that it has haddocks if necessary
     | getInstalledHaddock opts && isJust mcache && not (dpHaddock dp) = NeedsHaddock
+    -- Check that it has haddocks if necessary
+    | getInstalledSymbols opts && isJust mcache && not (dpSymbols dp) = NeedsSymbols
     | otherwise =
         case Map.lookup name sourceMap of
             Nothing ->
@@ -263,7 +277,7 @@ data LoadHelper = LoadHelper
     }
     deriving Show
 
-toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage Bool Bool -> LoadHelper
+toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage Bool Bool Bool -> LoadHelper
 toLoadHelper mloc dp = LoadHelper
     { lhId = gid
     , lhDeps =

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
@@ -197,6 +197,9 @@ getGhcOptions bconfig boptsCli name isTarget isLocal = concat
     , if boptsLibProfile bopts || boptsExeProfile bopts
          then ["-auto-all","-caf-all"]
          else []
+    , if not $ boptsLibStrip bopts || boptsExeStrip bopts
+         then ["-g"]
+         else []
     , if includeExtraOptions
          then boptsCLIGhcOptions boptsCli
          else []

diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs
@@ -15,6 +15,12 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
     , boptsExeProfile = fromFirst
           (boptsExeProfile defaultBuildOpts)
           buildMonoidExeProfile
+    , boptsLibStrip = fromFirst
+          (boptsLibStrip defaultBuildOpts)
+          buildMonoidLibStrip
+    , boptsExeStrip = fromFirst
+          (boptsExeStrip defaultBuildOpts)
+          buildMonoidExeStrip
     , boptsHaddock = fromFirst
           (boptsHaddock defaultBuildOpts)
           buildMonoidHaddock

diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs
@@ -122,7 +122,7 @@ createDependencyGraph dotOpts = do
   let graph = Map.fromList (localDependencies dotOpts (filter lpWanted locals))
   menv <- getMinimalEnvOverride
   installedMap <- fmap snd . fst4 <$> getInstalled menv
-                                                   (GetInstalledOpts False False)
+                                                   (GetInstalledOpts False False False)
                                                    sourceMap
   withLoadPackage menv (\loader -> do
     let depLoader =

diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs
@@ -531,6 +531,7 @@ getGhciPkgInfos sourceMap addPkgs mfileTargets localTargets = do
         GetInstalledOpts
             { getInstalledProfiling = False
             , getInstalledHaddock   = False
+            , getInstalledSymbols   = False
             }
         sourceMap
     let localLibs = [name | (name, (_, target)) <- localTargets, hasLocalComp isCLib target]

diff --git a/src/Stack/Options/BuildMonoidParser.hs b/src/Stack/Options/BuildMonoidParser.hs
@@ -13,14 +13,14 @@ import           Stack.Types.Config.Build
 
 buildOptsMonoidParser :: GlobalOptsContext -> Parser BuildOptsMonoid
 buildOptsMonoidParser hide0 =
-    transform <$> trace <*> profile <*> options
+    transform <$> trace <*> profile <*> noStrip <*> options
   where
     hideBool = hide0 /= BuildCmdGlobalOpts
     hide =
         hideMods hideBool
     hideExceptGhci =
         hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts])
-    transform tracing profiling =
+    transform tracing profiling noStripping =
         enable
       where
         enable opts
@@ -37,6 +37,11 @@ buildOptsMonoidParser hide0 =
                   additionalArgs
                 }
               }
+          | noStripping = 
+              opts
+              { buildMonoidLibStrip = First (Just False)
+              , buildMonoidExeStrip = First (Just False)
+              }
           | otherwise =
               opts
           where
@@ -75,13 +80,28 @@ buildOptsMonoidParser hide0 =
                     \for all expressions and generate a backtrace on \
                     \exception" <>
             hideExceptGhci)
+
+    noStrip =
+        flag
+            False
+            True
+            (long "no-strip" <>
+             help
+                 "Disable DWARF debugging symbol stripping in libraries, \
+                     \executables, etc. for all expressions, producing \
+                     \larger executables but allowing the use of standard \
+                     \debuggers/profiling tools/other utilities that use \
+                     \debugging symbols." <>
+             hideExceptGhci)
+
     options =
-        BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*>
-        haddockOptsParser hideBool <*> openHaddocks <*> haddockDeps <*>
-        haddockInternal <*> copyBins <*> preFetch <*> keepGoing <*>
-        forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*>
-        benchOptsParser hideBool <*> reconfigure <*>
-        cabalVerbose <*> splitObjs
+        BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> libStripping <*>
+        exeStripping <*> haddock <*> haddockOptsParser hideBool <*> 
+        openHaddocks <*> haddockDeps <*> haddockInternal <*> copyBins <*>
+        preFetch <*> keepGoing <*> forceDirty <*> tests <*>
+        testOptsParser hideBool <*> benches <*> benchOptsParser hideBool <*>
+        reconfigure <*> cabalVerbose <*> splitObjs
+
     libProfiling =
         firstBoolFlags
             "library-profiling"
@@ -92,6 +112,16 @@ buildOptsMonoidParser hide0 =
             "executable-profiling"
             "executable profiling for TARGETs and all its dependencies"
             hide
+    libStripping =
+        firstBoolFlags
+            "library-stripping"
+            "library stripping for TARGETs and all its dependencies"
+            hide
+    exeStripping =
+        firstBoolFlags
+            "executable-stripping"
+            "executable stripping for TARGETs and all its dependencies"
+            hide
     haddock =
         firstBoolFlags
             "haddock"