Merge pull request #6453 from commercialhaskell/other-prefix

Remove other prefixes from field names of types

Author: mpilgrem

src/Control/Concurrent/Execute.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors      #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
 
 -- Concurrent execution with dependencies. Types currently hard-coded for needs
 -- of stack, but could be generalized easily.
@@ -55,9 +57,9 @@ data Action = Action
     -- ^ The action's unique id.
   , actionDeps :: !(Set ActionId)
     -- ^ Actions on which this action depends.
-  , actionDo :: !(ActionContext -> IO ())
+  , action :: !(ActionContext -> IO ())
     -- ^ The action's 'IO' action, given a context.
-  , actionConcurrency :: !Concurrency
+  , concurrency :: !Concurrency
     -- ^ Whether this action may be run concurrently with others.
   }
 
@@ -69,20 +71,20 @@ data Concurrency
   deriving Eq
 
 data ActionContext = ActionContext
-  { acRemaining :: !(Set ActionId)
+  { remaining :: !(Set ActionId)
     -- ^ Does not include the current action.
-  , acDownstream :: [Action]
+  , downstream :: [Action]
     -- ^ Actions which depend on the current action.
-  , acConcurrency :: !Concurrency
+  , concurrency :: !Concurrency
     -- ^ Whether this action may be run concurrently with others.
   }
 
 data ExecuteState = ExecuteState
-  { esActions    :: TVar [Action]
-  , esExceptions :: TVar [SomeException]
-  , esInAction   :: TVar (Set ActionId)
-  , esCompleted  :: TVar Int
-  , esKeepGoing  :: Bool
+  { actions    :: TVar [Action]
+  , exceptions :: TVar [SomeException]
+  , inAction   :: TVar (Set ActionId)
+  , completed  :: TVar Int
+  , keepGoing  :: Bool
   }
 
 runActions ::
@@ -98,16 +100,16 @@ runActions threads keepGoing actions withProgress = do
     <*> newTVarIO Set.empty -- esInAction
     <*> newTVarIO 0 -- esCompleted
     <*> pure keepGoing -- esKeepGoing
-  _ <- async $ withProgress es.esCompleted es.esInAction
+  _ <- async $ withProgress es.completed es.inAction
   if threads <= 1
     then runActions' es
     else replicateConcurrently_ threads $ runActions' es
-  readTVarIO es.esExceptions
+  readTVarIO es.exceptions
 
 -- | Sort actions such that those that can't be run concurrently are at
 -- the end.
 sortActions :: [Action] -> [Action]
-sortActions = sortBy (compareConcurrency `on` (.actionConcurrency))
+sortActions = sortBy (compareConcurrency `on` (.concurrency))
  where
   -- NOTE: Could derive Ord. However, I like to make this explicit so
   -- that changes to the datatype must consider how it's affecting
@@ -124,53 +126,54 @@ runActions' es = loop
 
   breakOnErrs :: STM (IO ()) -> STM (IO ())
   breakOnErrs inner = do
-    errs <- readTVar es.esExceptions
-    if null errs || es.esKeepGoing
+    errs <- readTVar es.exceptions
+    if null errs || es.keepGoing
       then inner
       else doNothing
 
   withActions :: ([Action] -> STM (IO ())) -> STM (IO ())
   withActions inner = do
-    actions <- readTVar es.esActions
+    actions <- readTVar es.actions
     if null actions
       then doNothing
       else inner actions
 
   processActions :: [Action] -> STM (IO ())
   processActions actions = do
-    inAction <- readTVar es.esInAction
+    inAction <- readTVar es.inAction
     case break (Set.null . (.actionDeps)) actions of
       (_, []) -> do
         check (Set.null inAction)
-        unless es.esKeepGoing $
-          modifyTVar es.esExceptions (toException InconsistentDependenciesBug:)
+        unless es.keepGoing $
+          modifyTVar es.exceptions (toException InconsistentDependenciesBug:)
         doNothing
       (xs, action:ys) -> processAction inAction (xs ++ ys) action
 
   processAction :: Set ActionId -> [Action] -> Action -> STM (IO ())
   processAction inAction otherActions action = do
-    let concurrency = action.actionConcurrency
+    let concurrency = action.concurrency
     unless (concurrency == ConcurrencyAllowed) $
       check (Set.null inAction)
     let action' = action.actionId
         otherActions' = Set.fromList $ map (.actionId) otherActions
         remaining = Set.union otherActions' inAction
+        downstream = downstreamActions action' otherActions
         actionContext = ActionContext
-          { acRemaining = remaining
-          , acDownstream = downstreamActions action' otherActions
-          , acConcurrency = concurrency
+          { remaining
+          , downstream
+          , concurrency
           }
-    writeTVar es.esActions otherActions
-    modifyTVar es.esInAction (Set.insert action')
+    writeTVar es.actions otherActions
+    modifyTVar es.inAction (Set.insert action')
     pure $ do
       mask $ \restore -> do
-        eres <- try $ restore $ action.actionDo actionContext
+        eres <- try $ restore $ action.action actionContext
         atomically $ do
-          modifyTVar es.esInAction (Set.delete action')
-          modifyTVar es.esCompleted (+1)
+          modifyTVar es.inAction (Set.delete action')
+          modifyTVar es.completed (+1)
           case eres of
-            Left err -> modifyTVar es.esExceptions (err:)
-            Right () -> modifyTVar es.esActions $ map (dropDep action')
+            Left err -> modifyTVar es.exceptions (err:)
+            Right () -> modifyTVar es.actions $ map (dropDep action')
       loop
 
   -- | Filter a list of actions to include only those that depend on the given

src/Options/Applicative/Builder/Extra.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE NoFieldSelectors    #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 
 -- | Extra functions for optparse-applicative.
@@ -260,22 +261,22 @@ optionalFirstFalse = fmap FirstFalse . optional
 absFileOption :: Mod OptionFields (Path Abs File) -> Parser (Path Abs File)
 absFileOption mods = option (eitherReader' parseAbsFile) $
      completer
-       (pathCompleterWith defaultPathCompleterOpts { pcoRelative = False })
+       (pathCompleterWith defaultPathCompleterOpts { relative = False })
   <> mods
 
 relFileOption :: Mod OptionFields (Path Rel File) -> Parser (Path Rel File)
 relFileOption mods = option (eitherReader' parseRelFile) $
      completer
-       (pathCompleterWith defaultPathCompleterOpts { pcoAbsolute = False })
+       (pathCompleterWith defaultPathCompleterOpts { absolute = False })
   <> mods
 
 absDirOption :: Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
 absDirOption mods = option (eitherReader' parseAbsDir) $
      completer
        ( pathCompleterWith
           defaultPathCompleterOpts
-            { pcoRelative = False
-            , pcoFileFilter = const False
+            { relative = False
+            , fileFilter = const False
             }
        )
   <> mods
@@ -285,8 +286,8 @@ relDirOption mods = option (eitherReader' parseRelDir) $
      completer
        ( pathCompleterWith
            defaultPathCompleterOpts
-             { pcoAbsolute = False
-             , pcoFileFilter = const False
+             { absolute = False
+             , fileFilter = const False
              }
        )
   <> mods
@@ -296,20 +297,20 @@ eitherReader' :: Show e => (String -> Either e a) -> ReadM a
 eitherReader' f = eitherReader (mapLeft show . f)
 
 data PathCompleterOpts = PathCompleterOpts
-  { pcoAbsolute :: Bool
-  , pcoRelative :: Bool
-  , pcoRootDir :: Maybe FilePath
-  , pcoFileFilter :: FilePath -> Bool
-  , pcoDirFilter :: FilePath -> Bool
+  { absolute :: Bool
+  , relative :: Bool
+  , rootDir :: Maybe FilePath
+  , fileFilter :: FilePath -> Bool
+  , dirFilter :: FilePath -> Bool
   }
 
 defaultPathCompleterOpts :: PathCompleterOpts
 defaultPathCompleterOpts = PathCompleterOpts
-  { pcoAbsolute = True
-  , pcoRelative = True
-  , pcoRootDir = Nothing
-  , pcoFileFilter = const True
-  , pcoDirFilter = const True
+  { absolute = True
+  , relative = True
+  , rootDir = Nothing
+  , fileFilter = const True
+  , dirFilter = const True
   }
 
 fileCompleter :: Completer
@@ -318,11 +319,11 @@ fileCompleter = pathCompleterWith defaultPathCompleterOpts
 fileExtCompleter :: [String] -> Completer
 fileExtCompleter exts =
   pathCompleterWith
-    defaultPathCompleterOpts { pcoFileFilter = (`elem` exts) . takeExtension }
+    defaultPathCompleterOpts { fileFilter = (`elem` exts) . takeExtension }
 
 dirCompleter :: Completer
 dirCompleter =
-  pathCompleterWith defaultPathCompleterOpts { pcoFileFilter = const False }
+  pathCompleterWith defaultPathCompleterOpts { fileFilter = const False }
 
 pathCompleterWith :: PathCompleterOpts -> Completer
 pathCompleterWith pco = mkCompleter $ \inputRaw -> do
@@ -333,15 +334,15 @@ pathCompleterWith pco = mkCompleter $ \inputRaw -> do
   let (inputSearchDir0, searchPrefix) = splitFileName input
       inputSearchDir = if inputSearchDir0 == "./" then "" else inputSearchDir0
   msearchDir <-
-    case (isRelative inputSearchDir, pco.pcoAbsolute, pco.pcoRelative) of
+    case (isRelative inputSearchDir, pco.absolute, pco.relative) of
       (True, _, True) -> do
-        rootDir <- maybe getCurrentDirectory pure pco.pcoRootDir
+        rootDir <- maybe getCurrentDirectory pure pco.rootDir
         pure $ Just (rootDir </> inputSearchDir)
       (False, True, _) -> pure $ Just inputSearchDir
       _ -> pure Nothing
   case msearchDir of
     Nothing
-      | input == "" && pco.pcoAbsolute -> pure ["/"]
+      | input == "" && pco.absolute -> pure ["/"]
       | otherwise -> pure []
     Just searchDir -> do
       entries <-
@@ -354,7 +355,7 @@ pathCompleterWith pco = mkCompleter $ \inputRaw -> do
             if searchPrefix `isPrefixOf` entry
               then do
                 let path = searchDir </> entry
-                case (pco.pcoFileFilter path, pco.pcoDirFilter path) of
+                case (pco.fileFilter path, pco.dirFilter path) of
                   (True, True) -> pure $ Just (inputSearchDir </> entry)
                   (fileAllowed, dirAllowed) -> do
                     isDir <- doesDirectoryExist path

src/Stack/Build/Execute.hs

@@ -522,9 +522,9 @@ toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
           { actionId = ActionId (taskProvides task) ATBuild
           , actionDeps =
               Set.map (`ActionId` ATBuild) task.configOpts.missing
-          , actionDo =
+          , action =
               \ac -> runInBase $ singleBuild ac ee task installedMap False
-          , actionConcurrency = ConcurrencyAllowed
+          , concurrency = ConcurrencyAllowed
           }
       ]
   afinal = case mfinal of
@@ -536,9 +536,9 @@ toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
             { actionId = ActionId pkgId ATBuildFinal
             , actionDeps = addBuild
                 (Set.map (`ActionId` ATBuild) task.configOpts.missing)
-            , actionDo =
+            , action =
                 \ac -> runInBase $ singleBuild ac ee task installedMap True
-            , actionConcurrency = ConcurrencyAllowed
+            , concurrency = ConcurrencyAllowed
             }
       ) $
       -- These are the "final" actions - running tests and benchmarks.
@@ -547,20 +547,20 @@ toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
           else (:) Action
             { actionId = ActionId pkgId ATRunTests
             , actionDeps = finalDeps
-            , actionDo = \ac -> withLock mtestLock $ runInBase $
+            , action = \ac -> withLock mtestLock $ runInBase $
                 singleTest topts (Set.toList tests) ac ee task installedMap
               -- Always allow tests tasks to run concurrently with other tasks,
               -- particularly build tasks. Note that 'mtestLock' can optionally
               -- make it so that only one test is run at a time.
-            , actionConcurrency = ConcurrencyAllowed
+            , concurrency = ConcurrencyAllowed
             }
       ) $
       ( if Set.null benches
           then id
           else (:) Action
             { actionId = ActionId pkgId ATRunBenchmarks
             , actionDeps = finalDeps
-            , actionDo = \ac -> runInBase $
+            , action = \ac -> runInBase $
                 singleBench
                   beopts
                   (Set.toList benches)
@@ -570,7 +570,7 @@ toActions installedMap mtestLock runInBase ee (mbuild, mfinal) =
                   installedMap
               -- Never run benchmarks concurrently with any other task, see
               -- #3663
-            , actionConcurrency = ConcurrencyDisallowed
+            , concurrency = ConcurrencyDisallowed
             }
       )
       []

src/Stack/Build/ExecuteEnv.hs

@@ -602,10 +602,10 @@ withSingleContext
        (  wanted
        && all
             (\(ActionId ident _) -> ident == pkgId)
-            (Set.toList ac.acRemaining)
+            (Set.toList ac.remaining)
        && ee.totalWanted == 1
        )
-    || ac.acConcurrency == ConcurrencyDisallowed
+    || ac.concurrency == ConcurrencyDisallowed
 
   withPackage inner =
     case taskType of

src/Stack/Build/ExecutePackage.hs

@@ -456,8 +456,8 @@ singleBuild
           -- because their configure step will require that this
           -- package is built. See
           -- https://github.com/commercialhaskell/stack/issues/2787
-          (True, _) | null ac.acDownstream -> pure Nothing
-          (_, True) | null ac.acDownstream || installedMapHasThisPkg -> do
+          (True, _) | null ac.downstream -> pure Nothing
+          (_, True) | null ac.downstream || installedMapHasThisPkg -> do
             initialBuildSteps executableBuildStatuses cabal announce
             pure Nothing
           _ -> fulfillCuratorBuildExpectations
@@ -700,7 +700,7 @@ singleBuild
         let remaining =
               filter
                 (\(ActionId x _) -> x == pkgId)
-                (Set.toList ac.acRemaining)
+                (Set.toList ac.remaining)
         when (null remaining) $ removeDirRecur pkgDir
       TTLocalMutable{} -> pure ()