Apply args like --profile when converting from options Monoid #2399

src/Stack/Config/Build.hs

@@ -3,6 +3,7 @@
 -- | Build configuration
 module Stack.Config.Build where
 
+import           Data.Maybe
 import           Data.Monoid.Extra
 import           Stack.Types.Config
 
@@ -11,16 +12,20 @@ buildOptsFromMonoid :: BuildOptsMonoid -> BuildOpts
 buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
     { boptsLibProfile = fromFirst
           (boptsLibProfile defaultBuildOpts)
-          buildMonoidLibProfile
+          (buildMonoidLibProfile <>
+           First (if tracing || profiling then Just True else Nothing))
     , boptsExeProfile = fromFirst
           (boptsExeProfile defaultBuildOpts)
-          buildMonoidExeProfile
+          (buildMonoidExeProfile <>
+           First (if tracing || profiling then Just True else Nothing))
     , boptsLibStrip = fromFirst
           (boptsLibStrip defaultBuildOpts)
-          buildMonoidLibStrip
+          (buildMonoidLibStrip <>
+           First (if noStripping then Just False else Nothing))
     , boptsExeStrip = fromFirst
           (boptsExeStrip defaultBuildOpts)
-          buildMonoidExeStrip
+          (buildMonoidExeStrip <>
+           First (if noStripping then Just False else Nothing))
     , boptsHaddock = fromFirst
           (boptsHaddock defaultBuildOpts)
           buildMonoidHaddock
@@ -43,11 +48,13 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
           (boptsForceDirty defaultBuildOpts)
           buildMonoidForceDirty
     , boptsTests = fromFirst (boptsTests defaultBuildOpts) buildMonoidTests
-    , boptsTestOpts = testOptsFromMonoid buildMonoidTestOpts
+    , boptsTestOpts =
+          testOptsFromMonoid buildMonoidTestOpts additionalArgs
     , boptsBenchmarks = fromFirst
           (boptsBenchmarks defaultBuildOpts)
           buildMonoidBenchmarks
-    , boptsBenchmarkOpts = benchmarkOptsFromMonoid buildMonoidBenchmarkOpts
+    , boptsBenchmarkOpts =
+          benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs
     , boptsReconfigure = fromFirst
           (boptsReconfigure defaultBuildOpts)
           buildMonoidReconfigure
@@ -58,26 +65,46 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
           (boptsSplitObjs defaultBuildOpts)
           buildMonoidSplitObjs
     }
-
+  where
+    -- These options are not directly used in bopts, instead they
+    -- transform other options.
+    tracing = fromFirst False buildMonoidTrace
+    profiling = fromFirst False buildMonoidProfile
+    noStripping = getAny buildMonoidNoStrip
+    -- Additional args for tracing / profiling
+    additionalArgs =
+        if tracing || profiling
+            then Just $ "+RTS" : catMaybes [trac, prof, Just "-RTS"]
+            else Nothing
+    trac =
+        if tracing
+            then Just "-xc"
+            else Nothing
+    prof =
+        if profiling
+            then Just "-p"
+            else Nothing
 
 haddockOptsFromMonoid :: HaddockOptsMonoid -> HaddockOpts
 haddockOptsFromMonoid HaddockOptsMonoid{..} =
     defaultHaddockOpts
     {hoAdditionalArgs = hoMonoidAdditionalArgs}
 
-testOptsFromMonoid :: TestOptsMonoid -> TestOpts
-testOptsFromMonoid TestOptsMonoid{..} =
+testOptsFromMonoid :: TestOptsMonoid -> Maybe [String] -> TestOpts
+testOptsFromMonoid TestOptsMonoid{..} madditional =
     defaultTestOpts
     { toRerunTests = fromFirst (toRerunTests defaultTestOpts) toMonoidRerunTests
-    , toAdditionalArgs = toMonoidAdditionalArgs
+    , toAdditionalArgs = fromMaybe [] madditional <> toMonoidAdditionalArgs
     , toCoverage = fromFirst (toCoverage defaultTestOpts) toMonoidCoverage
     , toDisableRun = fromFirst (toDisableRun defaultTestOpts) toMonoidDisableRun
     }
 
-benchmarkOptsFromMonoid :: BenchmarkOptsMonoid -> BenchmarkOpts
-benchmarkOptsFromMonoid BenchmarkOptsMonoid{..} =
+benchmarkOptsFromMonoid :: BenchmarkOptsMonoid -> Maybe [String] -> BenchmarkOpts
+benchmarkOptsFromMonoid BenchmarkOptsMonoid{..} madditional =
     defaultBenchmarkOpts
-    { beoAdditionalArgs = getFirst beoMonoidAdditionalArgs
+    { beoAdditionalArgs =
+          (fmap (\args -> unwords args <> " ") madditional) <>
+          getFirst beoMonoidAdditionalArgs
     , beoDisableRun = fromFirst
           (beoDisableRun defaultBenchmarkOpts)
           beoMonoidDisableRun

src/Stack/Options/BuildMonoidParser.hs

@@ -1,6 +1,5 @@
 module Stack.Options.BuildMonoidParser where
 
-import           Data.Maybe                        (catMaybes)
 import           Data.Monoid.Extra
 import           Options.Applicative
 import           Options.Applicative.Builder.Extra
@@ -13,94 +12,46 @@ import           Stack.Types.Config.Build
 
 buildOptsMonoidParser :: GlobalOptsContext -> Parser BuildOptsMonoid
 buildOptsMonoidParser hide0 =
-    transform <$> trace <*> profile <*> noStrip <*> options
+    BuildOptsMonoid <$> trace <*> profile <*> noStrip <*>
+    libProfiling <*> exeProfiling <*> libStripping <*>
+    exeStripping <*> haddock <*> haddockOptsParser hideBool <*>
+    openHaddocks <*> haddockDeps <*> haddockInternal <*> copyBins <*>
+    preFetch <*> keepGoing <*> forceDirty <*> tests <*>
+    testOptsParser hideBool <*> benches <*> benchOptsParser hideBool <*>
+    reconfigure <*> cabalVerbose <*> splitObjs
   where
     hideBool = hide0 /= BuildCmdGlobalOpts
     hide =
         hideMods hideBool
     hideExceptGhci =
         hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts])
-    transform tracing profiling noStripping =
-        enable
-      where
-        enable opts
-          | tracing || profiling =
-              opts
-              { buildMonoidLibProfile = First (Just True)
-              , buildMonoidExeProfile = First (Just True)
-              , buildMonoidBenchmarkOpts = bopts
-                { beoMonoidAdditionalArgs = First (Just (" " <> unwords additionalArgs) <>
-                  getFirst (beoMonoidAdditionalArgs bopts))
-                }
-              , buildMonoidTestOpts = topts
-                { toMonoidAdditionalArgs = additionalArgs <> toMonoidAdditionalArgs topts
-                }
-              }
-          | noStripping =
-              opts
-              { buildMonoidLibStrip = First (Just False)
-              , buildMonoidExeStrip = First (Just False)
-              }
-          | otherwise =
-              opts
-          where
-            bopts =
-                buildMonoidBenchmarkOpts opts
-            topts =
-                buildMonoidTestOpts opts
-            additionalArgs =
-                "+RTS" : catMaybes [trac, prof, Just "-RTS"]
-            trac =
-                if tracing
-                    then Just "-xc"
-                    else Nothing
-            prof =
-                if profiling
-                    then Just "-p"
-                    else Nothing
-    profile =
-        flag
-            False
-            True
-            (long "profile" <>
-             help
-                 "Enable profiling in libraries, executables, etc. \
-                    \for all expressions and generate a profiling report\
-                    \ in tests or benchmarks" <>
-            hideExceptGhci)
 
     trace =
+        firstBoolFlags
+            "trace"
+            "Enable profiling in libraries, executables, etc. \
+                \for all expressions and generate a backtrace on \
+                \exception"
+            hideExceptGhci
+    profile =
+        firstBoolFlags
+            "profile"
+            "profiling in libraries, executables, etc. \
+                \for all expressions and generate a profiling report\
+                \ in tests or benchmarks"
+            hideExceptGhci
+    noStrip = fmap Any $
         flag
-            False
-            True
-            (long "trace" <>
-             help
-                 "Enable profiling in libraries, executables, etc. \
-                    \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." <>
+             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 <*> 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"

src/Stack/Types/Config/Build.hs

@@ -149,7 +149,10 @@ data BuildCommand
 
 -- | Build options that may be specified in the stack.yaml or from the CLI
 data BuildOptsMonoid = BuildOptsMonoid
-    { buildMonoidLibProfile :: !(First Bool)
+    { buildMonoidTrace :: !(First Bool)
+    , buildMonoidProfile :: !(First Bool)
+    , buildMonoidNoStrip :: !Any
+    , buildMonoidLibProfile :: !(First Bool)
     , buildMonoidExeProfile :: !(First Bool)
     , buildMonoidLibStrip :: !(First Bool)
     , buildMonoidExeStrip :: !(First Bool)
@@ -173,7 +176,10 @@ data BuildOptsMonoid = BuildOptsMonoid
 
 instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
   parseJSON = withObjectWarnings "BuildOptsMonoid"
-    (\o -> do buildMonoidLibProfile <- First <$> o ..:? buildMonoidLibProfileArgName
+    (\o -> do let buildMonoidTrace = First Nothing
+                  buildMonoidProfile = First Nothing
+                  buildMonoidNoStrip = Any False
+              buildMonoidLibProfile <- First <$> o ..:? buildMonoidLibProfileArgName
               buildMonoidExeProfile <-First <$>  o ..:? buildMonoidExeProfileArgName
               buildMonoidLibStrip <- First <$> o ..:? buildMonoidLibStripArgName
               buildMonoidExeStrip <-First <$>  o ..:? buildMonoidExeStripArgName