Merge pull request #6445 from commercialhaskell/various-prefix

Remove prefixes from various type field names

Author: mpilgrem

src/Stack/Build/Cache.hs

@@ -361,7 +361,7 @@ getPrecompiledCacheKey loc copts buildHaddocks = do
   -- In Cabal versions 1.22 and later, the configure options contain the
   -- installed package IDs, which is what we need for a unique hash. See also
   -- issue: https://github.com/commercialhaskell/stack/issues/1103
-  let input = copts.coNoDirs
+  let input = copts.noDirs
       optionsHash = Mem.convert $ hashWith SHA256 $ encodeUtf8 $ tshow input
 
   pure $ precompiledCacheKey

src/Stack/Build/ConstructPlan.hs

@@ -849,7 +849,7 @@ processDep pkgId name value = do
               Couldn'tResolveItsDependencies version
       pure $ Left (name, (range, mLatestApplicable, bd))
     Right adr
-      | isDepTypeLibrary value.dvType && not (adrHasLibrary adr) ->
+      | isDepTypeLibrary value.depType && not (adrHasLibrary adr) ->
           pure $ Left (name, (range, Nothing, HasNoLibrary))
     Right adr -> do
       addParent
@@ -864,7 +864,7 @@ processDep pkgId name value = do
             )
           )
  where
-  range = value.dvVersionRange
+  range = value.versionRange
   version = pkgVersion pkgId
   -- Update the parents map, for later use in plan construction errors
   -- - see 'getShortestDepsPath'.
@@ -1173,7 +1173,7 @@ checkAndWarnForUnknownTools p = do
   -- From Cabal 2.0, build-tools can specify a pre-built executable that should
   -- already be on the PATH.
   notOnPath toolName = MaybeT $ do
-    let settings = minimalEnvSettings { esIncludeLocals = True }
+    let settings = minimalEnvSettings { includeLocals = True }
     config <- view configL
     menv <- liftIO $ config.processContextSettings settings
     eFound <- runRIO menv $ findExecutable $ T.unpack toolName

src/Stack/Build/Execute.hs

@@ -242,11 +242,11 @@ executePlan
 
     config <- view configL
     menv' <- liftIO $ config.processContextSettings EnvSettings
-               { esIncludeLocals = True
-               , esIncludeGhcPackagePath = True
-               , esStackExe = True
-               , esLocaleUtf8 = False
-               , esKeepGhcRts = False
+               { includeLocals = True
+               , includeGhcPackagePath = True
+               , stackExe = True
+               , localeUtf8 = False
+               , keepGhcRts = False
                }
     withProcessContext menv' $
       forM_ boptsCli.exec $ \(cmd, args) ->

src/Stack/Build/ExecuteEnv.hs

@@ -675,11 +675,11 @@ withSingleContext
     unless config.allowDifferentUser $
       checkOwnership (pkgDir </> config.workDir)
     let envSettings = EnvSettings
-          { esIncludeLocals = taskTypeLocation taskType == Local
-          , esIncludeGhcPackagePath = False
-          , esStackExe = False
-          , esLocaleUtf8 = True
-          , esKeepGhcRts = False
+          { includeLocals = taskTypeLocation taskType == Local
+          , includeGhcPackagePath = False
+          , stackExe = False
+          , localeUtf8 = True
+          , keepGhcRts = False
           }
     menv <- liftIO $ config.processContextSettings envSettings
     distRelativeDir' <- distRelativeDir
@@ -748,7 +748,7 @@ withSingleContext
                   forM (Map.toList customSetupDeps) $ \(name, depValue) -> do
                     let matches (PackageIdentifier name' version) =
                              name == name'
-                          && version `withinRange` depValue.dvVersionRange
+                          && version `withinRange` depValue.versionRange
                     case filter (matches . fst) (Map.toList allDeps) of
                       x:xs -> do
                         unless (null xs) $

src/Stack/Build/ExecutePackage.hs

@@ -189,7 +189,7 @@ getConfigCache ee task installedMap enableTest enableBench = do
       opts = mkOpts missing'
       allDeps = Set.fromList $ Map.elems missing' ++ Map.elems task.present
       cache = ConfigCache
-        { opts = opts { coNoDirs = opts.coNoDirs ++ map T.unpack extra }
+        { opts = opts { noDirs = opts.noDirs ++ map T.unpack extra }
         , deps = allDeps
         , components =
             case task.taskType of
@@ -1044,11 +1044,11 @@ singleTest topts testsToRun ac ee task installedMap = do
           writeFileUtf8Builder fp ghcEnv
           menv <- liftIO $
             setEnv fp =<< config.processContextSettings EnvSettings
-              { esIncludeLocals = taskLocation task == Local
-              , esIncludeGhcPackagePath = True
-              , esStackExe = True
-              , esLocaleUtf8 = False
-              , esKeepGhcRts = False
+              { includeLocals = taskLocation task == Local
+              , includeGhcPackagePath = True
+              , stackExe = True
+              , localeUtf8 = False
+              , keepGhcRts = False
               }
           let emptyResult = Map.singleton testName Nothing
           withProcessContext menv $ if exists

src/Stack/DependencyGraph.hs

@@ -91,9 +91,9 @@ createPrunedDependencyGraph dotOpts = withDotConfig dotOpts $ do
     view $ buildConfigL . to (Map.keysSet . (.smWanted.project))
   logDebug "Creating dependency graph"
   resultGraph <- createDependencyGraph dotOpts
-  let pkgsToPrune = if dotOpts.dotIncludeBase
-                      then dotOpts.dotPrune
-                      else Set.insert "base" dotOpts.dotPrune
+  let pkgsToPrune = if dotOpts.includeBase
+                      then dotOpts.prune
+                      else Set.insert "base" dotOpts.prune
       prunedGraph = pruneGraph localNames pkgsToPrune resultGraph
   logDebug "Returning pruned dependency graph"
   pure (localNames, prunedGraph)
@@ -105,7 +105,7 @@ withDotConfig ::
   -> RIO Runner a
 withDotConfig opts inner =
   local (over globalOptsL modifyGO) $
-    if opts.dotGlobalHints
+    if opts.globalHints
       then withConfig NoReexec $ withBuildConfig withGlobalHints
       else withConfig YesReexec withReal
  where
@@ -165,13 +165,13 @@ withDotConfig opts inner =
 
   boptsCLI = defaultBuildOptsCLI
     { targets = opts.dotTargets
-    , flags = opts.dotFlags
+    , flags = opts.flags
     }
   modifyGO =
-    (if opts.dotTestTargets
+    (if opts.testTargets
        then set (globalOptsBuildOptsMonoidL . buildOptsMonoidTestsL) (Just True)
        else id) .
-    (if opts.dotBenchTargets
+    (if opts.benchTargets
        then set (globalOptsBuildOptsMonoidL . buildOptsMonoidBenchmarksL) (Just True)
        else id)
 
@@ -205,7 +205,7 @@ createDependencyGraph dotOpts = do
         | otherwise =
             fmap (setOfPackageDeps &&& makePayload loc)
                  (loadPackage loc flags ghcOptions cabalConfigOpts)
-  resolveDependencies dotOpts.dotDependencyDepth graph depLoader
+  resolveDependencies dotOpts.dependencyDepth graph depLoader
  where
   makePayload loc pkg = DotPayload (Just pkg.version)
                                    (Just pkg.license)
@@ -225,7 +225,7 @@ projectPackageDependencies dotOpts locals =
               in  (pkg.name, (deps pkg packageDepsSet, lpPayload pkg loc)))
       locals
  where
-  deps pkg packageDepsSet = if dotOpts.dotIncludeExternal
+  deps pkg packageDepsSet = if dotOpts.includeExternal
     then Set.delete pkg.name packageDepsSet
     else Set.intersection localNames packageDepsSet
   localNames = Set.fromList $ map (.package.name) locals

src/Stack/Docker.hs

@@ -97,27 +97,27 @@ getCmdArgs ::
   -> RIO env (FilePath,[String],[(String,String)],[Mount])
 getCmdArgs docker imageInfo isRemoteDocker = do
     config <- view configL
-    deUser <-
+    user <-
         if fromMaybe (not isRemoteDocker) docker.setUser
             then liftIO $ do
-              duUid <- User.getEffectiveUserID
-              duGid <- User.getEffectiveGroupID
-              duGroups <- nubOrd <$> User.getGroups
-              duUmask <- Files.setFileCreationMask 0o022
+              uid <- User.getEffectiveUserID
+              gid <- User.getEffectiveGroupID
+              groups <- nubOrd <$> User.getGroups
+              umask <- Files.setFileCreationMask 0o022
               -- Only way to get old umask seems to be to change it, so set it back afterward
-              _ <- Files.setFileCreationMask duUmask
+              _ <- Files.setFileCreationMask umask
               pure $ Just DockerUser
-                { duUid
-                , duGid
-                , duGroups
-                , duUmask
+                { uid
+                , gid
+                , groups
+                , umask
                 }
             else pure Nothing
     args <-
         fmap
           (  [ "--" ++ reExecArgName ++ "=" ++ showStackVersion
              , "--" ++ dockerEntrypointArgName
-             , show DockerEntrypoint {deUser}
+             , show DockerEntrypoint { user }
              ] ++
           )
           (liftIO getArgs)
@@ -498,7 +498,7 @@ entrypoint config@Config{} de = do
       estackUserEntry0 <- liftIO $ tryJust (guard . isDoesNotExistError) $
         User.getUserEntryForName stackUserName
       -- Switch UID/GID if needed, and update user's home directory
-      case de.deUser of
+      case de.user of
         Nothing -> pure ()
         Just (DockerUser 0 _ _ _) -> pure ()
         Just du -> withProcessContext envOverride $
@@ -530,13 +530,13 @@ entrypoint config@Config{} de = do
         -- directory
         readProcessNull "groupadd"
           [ "-o"
-          , "--gid",show du.duGid
+          , "--gid",show du.gid
           , stackUserName
           ]
         readProcessNull "useradd"
           [ "-oN"
-          , "--uid", show du.duUid
-          , "--gid", show du.duGid
+          , "--uid", show du.uid
+          , "--gid", show du.gid
           , "--home", toFilePathNoTrailingSep homeDir
           , stackUserName
           ]
@@ -545,27 +545,27 @@ entrypoint config@Config{} de = do
         -- and home directory
         readProcessNull "usermod"
           [ "-o"
-          , "--uid", show du.duUid
+          , "--uid", show du.uid
           , "--home", toFilePathNoTrailingSep homeDir
           , stackUserName
           ]
         readProcessNull "groupmod"
           [ "-o"
-          , "--gid", show du.duGid
+          , "--gid", show du.gid
           , stackUserName
           ]
-    forM_ du.duGroups $ \gid ->
+    forM_ du.groups $ \gid ->
       readProcessNull "groupadd"
         [ "-o"
         , "--gid", show gid
         , "group" ++ show gid
         ]
     -- 'setuid' to the wanted UID and GID
     liftIO $ do
-      User.setGroupID du.duGid
-      handleSetGroups du.duGroups
-      User.setUserID du.duUid
-      _ <- Files.setFileCreationMask du.duUmask
+      User.setGroupID du.gid
+      handleSetGroups du.groups
+      User.setUserID du.uid
+      _ <- Files.setFileCreationMask du.umask
       pure ()
   stackUserName = "stack" :: String
 

src/Stack/Dot.hs

@@ -42,7 +42,7 @@ printGraph dotOpts locals graph = do
   liftIO $ Text.putStrLn "}"
  where
   filteredLocals =
-    Set.filter (\local' -> local' `Set.notMember` dotOpts.dotPrune) locals
+    Set.filter (\local' -> local' `Set.notMember` dotOpts.prune) locals
 
 -- | Print the local nodes with a different style depending on options
 printLocalNodes ::
@@ -54,7 +54,7 @@ printLocalNodes dotOpts locals =
   liftIO $ Text.putStrLn (Text.intercalate "\n" lpNodes)
  where
   applyStyle :: Text -> Text
-  applyStyle n = if dotOpts.dotIncludeExternal
+  applyStyle n = if dotOpts.includeExternal
                    then n <> " [style=dashed];"
                    else n <> " [style=solid];"
   lpNodes :: [Text]

src/Stack/Hoogle.hs

@@ -277,11 +277,10 @@ hoogleCmd (args, setup, rebuild, startServer) =
             installHoogle
         | otherwise -> prettyThrowIO $ HoogleNotFound err
 
-  envSettings =
-    EnvSettings
-      { esIncludeLocals = True
-      , esIncludeGhcPackagePath = True
-      , esStackExe = True
-      , esLocaleUtf8 = False
-      , esKeepGhcRts = False
-      }
+  envSettings = EnvSettings
+    { includeLocals = True
+    , includeGhcPackagePath = True
+    , stackExe = True
+    , localeUtf8 = False
+    , keepGhcRts = False
+    }

src/Stack/Ls.hs

@@ -384,7 +384,7 @@ printTree opts dotOpts depth remainingDepsCounts packages dependencyMap =
     in  case Map.lookup name dependencyMap of
           Just (deps, payload) -> do
             printTreeNode opts dotOpts depth newDepsCounts deps payload name
-            if Just depth == dotOpts.dotDependencyDepth
+            if Just depth == dotOpts.dependencyDepth
               then pure ()
               else printTree opts dotOpts (depth + 1) newDepsCounts deps
                      dependencyMap
@@ -401,7 +401,7 @@ printTreeNode ::
   -> PackageName
   -> IO ()
 printTreeNode opts dotOpts depth remainingDepsCounts deps payload name =
-  let remainingDepth = fromMaybe 999 dotOpts.dotDependencyDepth - depth
+  let remainingDepth = fromMaybe 999 dotOpts.dependencyDepth - depth
       hasDeps = not $ null deps
   in  T.putStrLn $
         treeNodePrefix "" remainingDepsCounts hasDeps remainingDepth <> " " <>