synchronize source repos concurrently

Cabal/src/Distribution/Simple/Glob/Internal.hs

@@ -49,7 +49,7 @@ data Glob
     GlobFile !GlobPieces
   | -- | Trailing dir; a glob ending in @/@.
     GlobDirTrailing
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary Glob
 instance Structured Glob
@@ -65,7 +65,7 @@ data GlobPiece
     Literal String
   | -- | A union of patterns, e.g. @dir/{a,*.txt,c}/...@
     Union [GlobPieces]
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary GlobPiece
 instance Structured GlobPiece
@@ -457,8 +457,8 @@ checkNameMatches spec glob candidate
       -- if multidot is supported, then this is a clean match
       if enableMultidot spec
         then pure (GlobMatch ())
-        else -- if not, issue a warning saying multidot is needed for the match
 
+        else -- if not, issue a warning saying multidot is needed for the match
           let (_, candidateExts) = splitExtensions $ takeFileName candidate
               extractExts :: GlobPieces -> Maybe String
               extractExts [] = Nothing

cabal-install/cabal-install.cabal

@@ -247,7 +247,8 @@ library
         regex-base  >= 0.94.0.0 && <0.95,
         regex-posix >= 0.96.0.0 && <0.97,
         safe-exceptions >= 0.1.7.0 && < 0.2,
-        semaphore-compat >= 1.0.0 && < 1.1
+        semaphore-compat >= 1.0.0 && < 1.1,
+        transformers >= 0.5.6.2 && < 0.7
 
     if flag(native-dns)
       if os(windows)

cabal-install/src/Distribution/Client/FileMonitor.hs

@@ -52,6 +52,7 @@ import Data.Binary.Get (runGetOrFail)
 import qualified Data.ByteString.Lazy as BS
 import qualified Data.Hashable as Hashable
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 
 import Control.Exception
 import Control.Monad
@@ -93,20 +94,20 @@ data MonitorFilePath
       , monitorKindDir :: !MonitorKindDir
       , monitorPathGlob :: !RootedGlob
       }
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 data MonitorKindFile
   = FileExists
   | FileModTime
   | FileHashed
   | FileNotExists
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 data MonitorKindDir
   = DirExists
   | DirModTime
   | DirNotExists
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary MonitorFilePath
 instance Binary MonitorKindFile
@@ -202,8 +203,8 @@ monitorFileHashedSearchPath notFoundAtPaths foundAtPath =
 -- globs, which monitor may files at once.
 data MonitorStateFileSet
   = MonitorStateFileSet
-      ![MonitorStateFile]
-      ![MonitorStateGlob]
+      !(Set MonitorStateFile)
+      !(Set MonitorStateGlob)
   -- Morally this is not actually a set but a bag (represented by lists).
   -- There is no principled reason to use a bag here rather than a set, but
   -- there is also no particular gain either. That said, we do preserve the
@@ -231,7 +232,7 @@ data MonitorStateFile
       !MonitorKindDir
       !FilePath
       !MonitorStateFileStatus
-  deriving (Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 data MonitorStateFileStatus
   = MonitorStateFileExists
@@ -244,7 +245,7 @@ data MonitorStateFileStatus
     MonitorStateDirModTime !ModTime
   | MonitorStateNonExistent
   | MonitorStateAlreadyChanged
-  deriving (Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary MonitorStateFile
 instance Binary MonitorStateFileStatus
@@ -259,7 +260,7 @@ data MonitorStateGlob
       !MonitorKindDir
       !FilePathRoot
       !MonitorStateGlobRel
-  deriving (Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 data MonitorStateGlobRel
   = MonitorStateGlobDirs
@@ -272,7 +273,7 @@ data MonitorStateGlobRel
       !ModTime
       ![(FilePath, MonitorStateFileStatus)] -- invariant: sorted
   | MonitorStateGlobDirTrailing
-  deriving (Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary MonitorStateGlob
 instance Binary MonitorStateGlobRel
@@ -283,9 +284,11 @@ instance Structured MonitorStateGlobRel
 -- | We can build a 'MonitorStateFileSet' from a set of 'MonitorFilePath' by
 -- inspecting the state of the file system, and we can go in the reverse
 -- direction by just forgetting the extra info.
-reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
+reconstructMonitorFilePaths :: MonitorStateFileSet -> Set MonitorFilePath
 reconstructMonitorFilePaths (MonitorStateFileSet singlePaths globPaths) =
-  map getSinglePath singlePaths ++ map getGlobPath globPaths
+  Set.fromList $
+    map getSinglePath (Set.toList singlePaths)
+      <> map getGlobPath (Set.toList globPaths)
   where
     getSinglePath :: MonitorStateFile -> MonitorFilePath
     getSinglePath (MonitorStateFile kindfile kinddir filepath _) =
@@ -374,7 +377,7 @@ data MonitorChanged a b
     --
     -- The set of monitored files is also returned. This is useful
     -- for composing or nesting 'FileMonitor's.
-    MonitorUnchanged b [MonitorFilePath]
+    MonitorUnchanged b (Set MonitorFilePath)
   | -- | The monitor found that something changed. The reason is given.
     MonitorChanged (MonitorChangedReason a)
   deriving (Show)
@@ -569,14 +572,15 @@ probeFileSystem root (MonitorStateFileSet singlePaths globPaths) =
   runChangedM $ do
     sequence_
       [ probeMonitorStateFileStatus root file status
-      | MonitorStateFile _ _ file status <- singlePaths
+      | MonitorStateFile _ _ file status <- Set.toList singlePaths
       ]
     -- The glob monitors can require state changes
     globPaths' <-
-      sequence
-        [ probeMonitorStateGlob root globPath
-        | globPath <- globPaths
-        ]
+      Set.fromList
+        <$> sequence
+          [ probeMonitorStateGlob root globPath
+          | globPath <- Set.toList globPaths
+          ]
     return (MonitorStateFileSet singlePaths globPaths')
 
 -----------------------------------------------
@@ -849,7 +853,7 @@ updateFileMonitor
   -- ^ root directory
   -> Maybe MonitorTimestamp
   -- ^ timestamp when the update action started
-  -> [MonitorFilePath]
+  -> Set MonitorFilePath
   -- ^ files of interest relative to root
   -> a
   -- ^ the current key value
@@ -889,20 +893,20 @@ buildMonitorStateFileSet
   -- ^ existing file hashes
   -> FilePath
   -- ^ root directory
-  -> [MonitorFilePath]
+  -> Set MonitorFilePath
   -- ^ patterns of interest
   --   relative to root
   -> IO MonitorStateFileSet
 buildMonitorStateFileSet mstartTime hashcache root =
-  go [] []
+  go mempty mempty . Set.toList
   where
     go
-      :: [MonitorStateFile]
-      -> [MonitorStateGlob]
+      :: Set MonitorStateFile
+      -> Set MonitorStateGlob
       -> [MonitorFilePath]
       -> IO MonitorStateFileSet
     go !singlePaths !globPaths [] =
-      return (MonitorStateFileSet (reverse singlePaths) (reverse globPaths))
+      return (MonitorStateFileSet singlePaths globPaths)
     go
       !singlePaths
       !globPaths
@@ -916,7 +920,7 @@ buildMonitorStateFileSet mstartTime hashcache root =
               kinddir
               root
               path
-        go (monitorState : singlePaths) globPaths monitors
+        go (Set.insert monitorState singlePaths) globPaths monitors
     go
       !singlePaths
       !globPaths
@@ -929,7 +933,7 @@ buildMonitorStateFileSet mstartTime hashcache root =
             kinddir
             root
             globPath
-        go singlePaths (monitorState : globPaths) monitors
+        go singlePaths (Set.insert monitorState globPaths) monitors
 
 buildMonitorStateFile
   :: Maybe MonitorTimestamp
@@ -1129,7 +1133,7 @@ readCacheFileHashes monitor =
       collectAllFileHashes singlePaths
         `Map.union` collectAllGlobHashes globPaths
 
-    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, Hash)
+    collectAllFileHashes :: Set MonitorStateFile -> Map FilePath (ModTime, Hash)
     collectAllFileHashes singlePaths =
       Map.fromList
         [ (fpath, (mtime, hash))
@@ -1138,14 +1142,14 @@ readCacheFileHashes monitor =
             _
             fpath
             (MonitorStateFileHashed mtime hash) <-
-            singlePaths
+            Set.toList singlePaths
         ]
 
-    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, Hash)
+    collectAllGlobHashes :: Set MonitorStateGlob -> Map FilePath (ModTime, Hash)
     collectAllGlobHashes globPaths =
       Map.fromList
         [ (fpath, (mtime, hash))
-        | MonitorStateGlob _ _ _ gstate <- globPaths
+        | MonitorStateGlob _ _ _ gstate <- Set.toList globPaths
         , (fpath, (mtime, hash)) <- collectGlobHashes "" gstate
         ]
 

cabal-install/src/Distribution/Client/Glob.hs

@@ -39,7 +39,7 @@ data RootedGlob
       -- ^ what the glob is relative to
       Glob
       -- ^ the glob
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary RootedGlob
 instance Structured RootedGlob
@@ -49,7 +49,7 @@ data FilePathRoot
   | -- | e.g. @"/"@, @"c:\"@ or result of 'takeDrive'
     FilePathRoot FilePath
   | FilePathHomeDir
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Binary FilePathRoot
 instance Structured FilePathRoot

cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs

@@ -226,7 +226,7 @@ updatePackageConfigFileMonitor
       pkgFileMonitorConfig
       srcdir
       Nothing
-      []
+      mempty
       pkgconfig
       ()
     where
@@ -238,7 +238,7 @@ updatePackageBuildFileMonitor
   -> MonitorTimestamp
   -> ElaboratedConfiguredPackage
   -> BuildStatusRebuild
-  -> [MonitorFilePath]
+  -> Set MonitorFilePath
   -> BuildResultMisc
   -> IO ()
 updatePackageBuildFileMonitor
@@ -285,7 +285,7 @@ updatePackageRegFileMonitor
       pkgFileMonitorReg
       srcdir
       Nothing
-      []
+      mempty
       ()
       mipkg
 

cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

@@ -91,6 +91,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LBS.Char8
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as Set
 
 import Control.Exception (ErrorCall, Handler (..), SomeAsyncException, assert, catches)
 import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile)
@@ -473,7 +474,7 @@ buildInplaceUnpackedPackage
             let listSimple =
                   execRebuild srcdir (needElaboratedConfiguredPackage pkg)
                 listSdist =
-                  fmap (map monitorFileHashed) $
+                  fmap (Set.fromList . map monitorFileHashed) $
                     allPackageSourceFiles verbosity srcdir
                 ifNullThen m m' = do
                   xs <- m
@@ -499,19 +500,20 @@ buildInplaceUnpackedPackage
                     listSimple
 
             let dep_monitors =
-                  map monitorFileHashed $
-                    elabInplaceDependencyBuildCacheFiles
-                      distDirLayout
-                      pkgshared
-                      plan
-                      pkg
+                  Set.fromList $
+                    map monitorFileHashed $
+                      elabInplaceDependencyBuildCacheFiles
+                        distDirLayout
+                        pkgshared
+                        plan
+                        pkg
             updatePackageBuildFileMonitor
               packageFileMonitor
               srcdir
               timestamp
               pkg
               buildStatus
-              (monitors ++ dep_monitors)
+              (monitors <> dep_monitors)
               buildResult
         PBHaddockPhase{runHaddock} -> do
           runHaddock
@@ -933,4 +935,3 @@ withTempInstalledPackageInfoFile verbosity tempdir action =
           unlines warns
 
       return ipkg
-