Remove prefixes from field names of various types

lh/LoadHelper, rr/ResolveResult, pi/PathInfo, so/ScriptOpts, sdopts/SDistOpts, hs/HaskellStackOrg, sco/SetupCmdOpts, upopts/UnpackOpts, _bo/BinaryOpts, _uo/UpgradeOpts, uo/UploadOpts, hc/HackageCreds.

Author: mpilgrem

src/Stack/Build/Installed.hs

@@ -132,8 +132,8 @@ loadDatabase installMap db lhs0 = do
   pkgexe <- getGhcPkgExe
   (lhs1', dps) <- ghcPkgDump pkgexe pkgDb $ conduitDumpPackage .| sink
   lhs1 <- mapMaybeM processLoadResult lhs1'
-  let lhs = pruneDeps id (.lhId) (.lhDeps) const (lhs0 ++ lhs1)
-  pure (map (\lh -> lh { lhDeps = [] }) $ Map.elems lhs, dps)
+  let lhs = pruneDeps id (.ghcPkgId) (.depsGhcPkgId) const (lhs0 ++ lhs1)
+  pure (map (\lh -> lh { depsGhcPkgId = [] }) $ Map.elems lhs, dps)
  where
   pkgDb = case db of
     GlobalPkgDb -> []
@@ -152,7 +152,7 @@ loadDatabase installMap db lhs0 = do
   processLoadResult (reason, lh) = do
     logDebug $
          "Ignoring package "
-      <> fromPackageName (fst lh.lhPair)
+      <> fromPackageName (fst lh.pair)
       <> case db of
            GlobalPkgDb -> mempty
            UserPkgDb loc fp -> ", from " <> displayShow (loc, fp) <> ","
@@ -241,13 +241,13 @@ isAllowed installMap pkgDb dp = case Map.lookup name installMap of
 
 -- | Type representing certain information about an installed package.
 data LoadHelper = LoadHelper
-  { lhId :: !GhcPkgId
+  { ghcPkgId :: !GhcPkgId
     -- ^ The package's id.
-  , lhSublibrary :: !(Maybe SublibDump)
-  , lhDeps :: ![GhcPkgId]
+  , subLibDump :: !(Maybe SublibDump)
+  , depsGhcPkgId :: ![GhcPkgId]
     -- ^ Unless the package's name is that of a 'wired-in' package, a list of
     -- the ids of the installed packages that are the package's dependencies.
-  , lhPair :: !(PackageName, (InstallLocation, Installed))
+  , pair :: !(PackageName, (InstallLocation, Installed))
     -- ^ A pair of (a) the package's name and (b) a pair of the relevant
     -- database (write-only or mutable) and information about the library
     -- installed.
@@ -256,33 +256,33 @@ data LoadHelper = LoadHelper
 
 toLoadHelper :: PackageDbVariety -> DumpPackage -> LoadHelper
 toLoadHelper pkgDb dp = LoadHelper
-  { lhId = gid
-  , lhDeps =
-      -- We always want to consider the wired in packages as having all of their
-      -- dependencies installed, since we have no ability to reinstall them.
-      -- This is especially important for using different minor versions of GHC,
-      -- where the dependencies of wired-in packages may change slightly and
-      -- therefore not match the snapshot.
-      if name `Set.member` wiredInPackages
-        then []
-        else dp.depends
-  , lhSublibrary = dp.sublib
-  , lhPair =
-      ( name
-      , (toInstallLocation pkgDb, Library ident installedLibInfo)
-      )
+  { ghcPkgId
+  , depsGhcPkgId
+  , subLibDump = dp.sublib
+  , pair
   }
  where
-  installedLibInfo = InstalledLibraryInfo gid (Right <$> dp.license) mempty
-  gid = dp.ghcPkgId
+  ghcPkgId = dp.ghcPkgId
   ident@(PackageIdentifier name _) = dp.packageIdent
+  depsGhcPkgId =
+    -- We always want to consider the wired in packages as having all of their
+    -- dependencies installed, since we have no ability to reinstall them. This
+    -- is especially important for using different minor versions of GHC, where
+    -- the dependencies of wired-in packages may change slightly and therefore
+    -- not match the snapshot.
+    if name `Set.member` wiredInPackages
+      then []
+      else dp.depends
+  installedLibInfo = InstalledLibraryInfo ghcPkgId (Right <$> dp.license) mempty
 
   toInstallLocation :: PackageDbVariety -> InstallLocation
   toInstallLocation GlobalDb = Snap
   toInstallLocation ExtraDb = Snap
   toInstallLocation WriteOnlyDb = Snap
   toInstallLocation MutableDb = Local
 
+  pair = (name, (toInstallLocation pkgDb, Library ident installedLibInfo))
+
 -- | This is where sublibraries and main libraries are assembled into a single
 -- entity Installed package, where all ghcPkgId live.
 gatherAndTransformSubLoadHelper ::
@@ -302,16 +302,16 @@ gatherAndTransformSubLoadHelper lh =
           { subLib = Map.union
               incomingLibInfo.subLib
               existingLibInfo.subLib
-          , ghcPkgId = if isJust lh.lhSublibrary
+          , ghcPkgId = if isJust lh.subLibDump
                       then existingLibInfo.ghcPkgId
                       else incomingLibInfo.ghcPkgId
           }
       )
   onPreviousLoadHelper newVal _oldVal = newVal
-  (key, value) = case lh.lhSublibrary of
+  (key, value) = case lh.subLibDump of
     Nothing -> (rawPackageName, rawValue)
     Just sd -> (sd.packageName, updateAsSublib sd <$> rawValue)
-  (rawPackageName, rawValue) = lh.lhPair
+  (rawPackageName, rawValue) = lh.pair
   updateAsSublib
       sd
       (Library (PackageIdentifier _sublibMungedPackageName version) libInfo)

src/Stack/Build/Target.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiWayIf            #-}
+{-# LANGUAGE NoFieldSelectors      #-}
 {-# LANGUAGE OverloadedRecordDot   #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE ViewPatterns          #-}
@@ -101,7 +102,7 @@ data NeedTargets
 --------------------------------------------------------------------------------
 
 -- | Raw target information passed on the command line.
-newtype RawInput = RawInput { unRawInput :: Text }
+newtype RawInput = RawInput { rawInput :: Text }
 
 getRawInput ::
      BuildOptsCLI
@@ -235,13 +236,13 @@ parseRawTarget t =
 --------------------------------------------------------------------------------
 
 data ResolveResult = ResolveResult
-  { rrName :: !PackageName
-  , rrRaw :: !RawInput
-  , rrComponent :: !(Maybe NamedComponent)
+  { name :: !PackageName
+  , rawInput :: !RawInput
+  , component :: !(Maybe NamedComponent)
     -- ^ Was a concrete component specified?
-  , rrAddedDep :: !(Maybe PackageLocationImmutable)
+  , addedDep :: !(Maybe PackageLocationImmutable)
     -- ^ Only if we're adding this as a dependency
-  , rrPackageType :: !PackageType
+  , packageType :: !PackageType
   }
 
 -- | Convert a 'RawTarget' into a 'ResolveResult' (see description on the
@@ -252,7 +253,7 @@ resolveRawTarget ::
   -> Map PackageName PackageLocation
   -> (RawInput, RawTarget)
   -> RIO env (Either StyleDoc ResolveResult)
-resolveRawTarget sma allLocs (ri, rt) =
+resolveRawTarget sma allLocs (rawInput, rt) =
   go rt
  where
   locals = sma.project
@@ -283,12 +284,12 @@ resolveRawTarget sma allLocs (ri, rt) =
           , style Shell $ flow "stack ide targets"
           , flow "for a list of available targets."
           ]
-      [(name, comp)] -> Right ResolveResult
-        { rrName = name
-        , rrRaw = ri
-        , rrComponent = Just comp
-        , rrAddedDep = Nothing
-        , rrPackageType = PTProject
+      [(name, component)] -> Right ResolveResult
+        { name
+        , rawInput
+        , component = Just component
+        , addedDep = Nothing
+        , packageType = PTProject
         }
       matches -> Left $
            fillSep
@@ -321,41 +322,43 @@ resolveRawTarget sma allLocs (ri, rt) =
       Just pp -> do
         comps <- ppComponents pp
         pure $ case ucomp of
-          ResolvedComponent comp
-            | comp `Set.member` comps -> Right ResolveResult
-                { rrName = name
-                , rrRaw = ri
-                , rrComponent = Just comp
-                , rrAddedDep = Nothing
-                , rrPackageType = PTProject
+          ResolvedComponent component
+            | component `Set.member` comps -> Right ResolveResult
+                { name
+                , rawInput
+                , component = Just component
+                , addedDep = Nothing
+                , packageType = PTProject
                 }
             | otherwise -> Left $
                 fillSep
                   [ "Component"
-                  , style Target (fromString $ T.unpack $ renderComponent comp)
+                  , style
+                      Target
+                      (fromString $ T.unpack $ renderComponent component)
                   , flow "does not exist in package"
                   , style Target (fromPackageName name) <> "."
                   ]
-          UnresolvedComponent comp ->
-            case filter (isCompNamed comp) $ Set.toList comps of
+          UnresolvedComponent comp' ->
+            case filter (isCompNamed comp') $ Set.toList comps of
               [] -> Left $
                 fillSep
                   [ "Component"
-                  , style Target (fromString $ T.unpack comp)
+                  , style Target (fromString $ T.unpack comp')
                   , flow "does not exist in package"
                   , style Target (fromPackageName name) <> "."
                   ]
-              [x] -> Right ResolveResult
-                { rrName = name
-                , rrRaw = ri
-                , rrComponent = Just x
-                , rrAddedDep = Nothing
-                , rrPackageType = PTProject
+              [component] -> Right ResolveResult
+                { name
+                , rawInput
+                , component = Just component
+                , addedDep = Nothing
+                , packageType = PTProject
                 }
               matches -> Left $
                 fillSep
                   [ flow "Ambiguous component name"
-                  , style Target (fromString $ T.unpack comp)
+                  , style Target (fromString $ T.unpack comp')
                   , flow "for package"
                   , style Target (fromPackageName name)
                   , flow "matches components:"
@@ -369,11 +372,11 @@ resolveRawTarget sma allLocs (ri, rt) =
 
   go (RTPackage name)
     | Map.member name locals = pure $ Right ResolveResult
-        { rrName = name
-        , rrRaw = ri
-        , rrComponent = Nothing
-        , rrAddedDep = Nothing
-        , rrPackageType = PTProject
+        { name
+        , rawInput
+        , component = Nothing
+        , addedDep = Nothing
+        , packageType = PTProject
         }
     | Map.member name deps =
         pure $ deferToConstructPlan name
@@ -428,12 +431,12 @@ resolveRawTarget sma allLocs (ri, rt) =
             pure $ case mrev of
               Nothing -> deferToConstructPlan name
               Just (_rev, cfKey, treeKey) -> Right ResolveResult
-                { rrName = name
-                , rrRaw = ri
-                , rrComponent = Nothing
-                , rrAddedDep = Just $
+                { name
+                , rawInput
+                , component = Nothing
+                , addedDep = Just $
                     PLIHackage (PackageIdentifier name version) cfKey treeKey
-                , rrPackageType = PTDependency
+                , packageType = PTDependency
                 }
 
   hackageLatest name = do
@@ -443,36 +446,36 @@ resolveRawTarget sma allLocs (ri, rt) =
       Nothing -> deferToConstructPlan name
       Just loc ->
         Right ResolveResult
-          { rrName = name
-          , rrRaw = ri
-          , rrComponent = Nothing
-          , rrAddedDep = Just loc
-          , rrPackageType = PTDependency
+          { name
+          , rawInput
+          , component = Nothing
+          , addedDep = Just loc
+          , packageType = PTDependency
           }
 
   hackageLatestRevision name version = do
     mrev <- getLatestHackageRevision YesRequireHackageIndex name version
     pure $ case mrev of
       Nothing -> deferToConstructPlan name
       Just (_rev, cfKey, treeKey) -> Right ResolveResult
-        { rrName = name
-        , rrRaw = ri
-        , rrComponent = Nothing
-        , rrAddedDep =
+        { name
+        , rawInput
+        , component = Nothing
+        , addedDep =
             Just $ PLIHackage (PackageIdentifier name version) cfKey treeKey
-        , rrPackageType = PTDependency
+        , packageType = PTDependency
         }
 
   -- This is actually an error case. We _could_ pure a Left value here, but it
   -- turns out to be better to defer this until the ConstructPlan phase, and let
   -- it complain about the missing package so that we get more errors together,
   -- plus the fancy colored output from that module.
   deferToConstructPlan name = Right ResolveResult
-    { rrName = name
-    , rrRaw = ri
-    , rrComponent = Nothing
-    , rrAddedDep = Nothing
-    , rrPackageType = PTDependency
+    { name
+    , rawInput
+    , component = Nothing
+    , addedDep = Nothing
+    , packageType = PTDependency
     }
 --------------------------------------------------------------------------------
 -- Combine the ResolveResults
@@ -489,23 +492,23 @@ combineResolveResults ::
        )
 combineResolveResults results = do
   addedDeps <- fmap Map.unions $ forM results $ \result ->
-    case result.rrAddedDep of
+    case result.addedDep of
       Nothing -> pure Map.empty
-      Just pl -> pure $ Map.singleton result.rrName pl
+      Just pl -> pure $ Map.singleton result.name pl
 
   let m0 = Map.unionsWith (++) $
-        map (\rr -> Map.singleton rr.rrName [rr]) results
+        map (\rr -> Map.singleton rr.name [rr]) results
       (errs, ms) = partitionEithers $ flip map (Map.toList m0) $
         \(name, rrs) ->
-          let mcomps = map (.rrComponent) rrs in
+          let mcomps = map (.component) rrs in
           -- Confirm that there is either exactly 1 with no component, or that
           -- all rrs are components
           case rrs of
             [] -> assert False $
               Left $
                 flow "Somehow got no rrComponent values, that can't happen."
-            [rr] | isNothing rr.rrComponent ->
-              Right $ Map.singleton name $ TargetAll rr.rrPackageType
+            [rr] | isNothing rr.component ->
+              Right $ Map.singleton name $ TargetAll rr.packageType
             _
               | all isJust mcomps ->
                   Right $ Map.singleton name $ TargetComps $ Set.fromList $
@@ -521,7 +524,7 @@ combineResolveResults results = do
   pure (errs, Map.unions ms, addedDeps)
  where
   rrToStyleDoc :: ResolveResult -> StyleDoc
-  rrToStyleDoc = fromString . T.unpack . (.rrRaw.unRawInput)
+  rrToStyleDoc = fromString . T.unpack . (.rawInput.rawInput)
 
 --------------------------------------------------------------------------------
 -- OK, let's do it!

src/Stack/CLI.hs

@@ -454,7 +454,7 @@ commandLineHandler currentDir progName isInterpreter =
     "Run a Stack script."
     globalFooter
     scriptCmd
-    (\so gom -> gom { resolverRoot = First $ Just $ takeDirectory so.soFile })
+    (\so gom -> gom { resolverRoot = First $ Just $ takeDirectory so.file })
     (globalOpts OtherCmdGlobalOpts)
     scriptOptsParser