Move Distribution.Client.Compat.Time to Distribution.Compat.Time.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Cabal/Cabal.cabal

@@ -212,6 +212,10 @@ source-repository head
 flag bundled-binary-generic
   default: False
 
+flag old-directory
+  description:  Use directory < 1.2 and old-time
+  default:      False
+
 library
   build-depends:
     array      >= 0.1 && < 0.6,
@@ -219,12 +223,18 @@ library
     bytestring >= 0.9 && < 1,
     containers >= 0.4 && < 0.6,
     deepseq    >= 1.3 && < 1.5,
-    directory  >= 1.1 && < 1.3,
     filepath   >= 1.3 && < 1.5,
     pretty     >= 1.1 && < 1.2,
     process    >= 1.1.0.1 && < 1.5,
     time       >= 1.4 && < 1.7
 
+  if flag(old-directory)
+    build-depends: directory >= 1.1 && < 1.2, old-time >= 1 && < 1.2,
+                   process   >= 1.0.1.1  && < 1.1.0.2
+  else
+    build-depends: directory >= 1.2 && < 1.3,
+                   process   >= 1.1.0.2  && < 1.5
+
   if flag(bundled-binary-generic)
     build-depends: binary >= 0.5 && < 0.7
   else
@@ -254,6 +264,7 @@ library
     Distribution.Compat.Internal.TempFile
     Distribution.Compat.ReadP
     Distribution.Compat.Semigroup
+    Distribution.Compat.Time
     Distribution.Compiler
     Distribution.InstalledPackageInfo
     Distribution.License
@@ -364,9 +375,11 @@ test-suite unit-tests
   build-depends:
     base,
     directory,
+    filepath,
     tasty,
     tasty-hunit,
     tasty-quickcheck,
+    tagged,
     pretty,
     QuickCheck >= 2.7 && < 2.9,
     Cabal

cabal-install/Distribution/Client/Compat/Time.hs → Cabal/Distribution/Compat/Time.hs

-{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving #-}
-module Distribution.Client.Compat.Time
+{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
+module Distribution.Compat.Time
        ( ModTime(..) -- Needed for testing
        , getModTime, getFileAge, getCurTime
-       , posixSecondsToModTime )
+       , posixSecondsToModTime
+       , calibrateMtimeChangeDelay )
        where
 
 import Control.Arrow    ( first )
@@ -11,11 +12,16 @@ import Data.Word        ( Word64 )
 import System.Directory ( getModificationTime )
 
 import Distribution.Compat.Binary ( Binary )
+import Distribution.Simple.Utils ( withTempDirectory )
+import Distribution.Verbosity ( silent )
+
+import System.FilePath
+import Control.Monad
 
 import Data.Time.Clock.POSIX ( POSIXTime, getPOSIXTime )
+import Data.Time             ( diffUTCTime, getCurrentTime )
 #if MIN_VERSION_directory(1,2,0)
 import Data.Time.Clock.POSIX ( posixDayLength )
-import Data.Time             ( diffUTCTime, getCurrentTime )
 #else
 import System.Time ( getClockTime, diffClockTimes
                    , normalizeTimeDiff, tdDay, tdHour )
@@ -73,7 +79,7 @@ getModTime path = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do
   if not res
     then do
       let err = mkIOError doesNotExistErrorType
-                "Distribution.Client.Compat.Time.getModTime"
+                "Distribution.Compat.Time.getModTime"
                 Nothing (Just path)
       ioError err
     else do
@@ -165,3 +171,32 @@ getFileAge file = do
 -- | Return the current time as 'ModTime'.
 getCurTime :: IO ModTime
 getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.
+
+-- | Based on code written by Neil Mitchell for Shake. See
+-- 'sleepFileTimeCalibrate' in 'Test.Type'.  Returns a pair
+-- of the maximum delay seen, and the recommended delay to
+-- use before testing for file modification change.
+-- The returned delay is never smaller
+-- than 10 ms, but never larger than 1 second.
+calibrateMtimeChangeDelay :: IO (Int, Int)
+calibrateMtimeChangeDelay = do
+  withTempDirectory silent "." "calibration-" $ \dir -> do
+    let fileName = dir </> "probe"
+    mtimes <- forM [1..25] $ \(i::Int) -> time $ do
+      writeFile fileName $ show i
+      t0 <- getModTime fileName
+      let spin j = do
+            writeFile fileName $ show (i,j)
+            t1 <- getModTime fileName
+            unless (t0 < t1) (spin $ j + 1)
+      spin (0::Int)
+    let mtimeChange  = maximum mtimes
+        mtimeChange' = min 1000000 $ (max 10000 mtimeChange) * 2
+    return (mtimeChange, mtimeChange')
+  where
+    time :: IO () -> IO Int
+    time act = do
+      t0 <- getCurrentTime
+      act
+      t1 <- getCurrentTime
+      return . ceiling $! (t1 `diffUTCTime` t0) * 1e6 -- microseconds

Cabal/tests/UnitTests.hs

+{-# LANGUAGE DeriveDataTypeable #-}
 module Main
     ( main
     ) where
 
 import Test.Tasty
+import Test.Tasty.Options
+
+import Data.Proxy
+import Data.Typeable
+
+import Distribution.Simple.Utils
+import Distribution.Verbosity
+import Distribution.Compat.Time
 
 import qualified UnitTests.Distribution.Compat.CreatePipe
 import qualified UnitTests.Distribution.Compat.ReadP
+import qualified UnitTests.Distribution.Compat.Time
 import qualified UnitTests.Distribution.Simple.Program.Internal
 import qualified UnitTests.Distribution.Simple.Utils
 import qualified UnitTests.Distribution.System
 import qualified UnitTests.Distribution.Utils.NubList
 import qualified UnitTests.Distribution.Version (versionTests)
 
-tests :: TestTree
-tests = testGroup "Unit Tests" $
+tests :: Int -> TestTree
+tests mtimeChangeCalibrated =
+  askOption $ \(OptionMtimeChangeDelay mtimeChangeProvided) ->
+  let mtimeChange = if mtimeChangeProvided /= 0
+                    then mtimeChangeProvided
+                    else mtimeChangeCalibrated
+  in
+  testGroup "Unit Tests" $
     [ testGroup "Distribution.Compat.CreatePipe"
         UnitTests.Distribution.Compat.CreatePipe.tests
     , testGroup "Distribution.Compat.ReadP"
         UnitTests.Distribution.Compat.ReadP.tests
+    , testGroup "Distribution.Compat.Time"
+        (UnitTests.Distribution.Compat.Time.tests mtimeChange)
     , testGroup "Distribution.Simple.Program.Internal"
         UnitTests.Distribution.Simple.Program.Internal.tests
     , testGroup "Distribution.Simple.Utils"
@@ -30,5 +48,31 @@ tests = testGroup "Unit Tests" $
         UnitTests.Distribution.Version.versionTests
     ]
 
+extraOptions :: [OptionDescription]
+extraOptions =
+  [ Option (Proxy :: Proxy OptionMtimeChangeDelay)
+  ]
+
+newtype OptionMtimeChangeDelay = OptionMtimeChangeDelay Int
+  deriving Typeable
+
+instance IsOption OptionMtimeChangeDelay where
+  defaultValue   = OptionMtimeChangeDelay 0
+  parseValue     = fmap OptionMtimeChangeDelay . safeRead
+  optionName     = return "mtime-change-delay"
+  optionHelp     = return $ "How long to wait before attempting to detect"
+                   ++ "file modification, in microseconds"
+
 main :: IO ()
-main = defaultMain tests
+main = do
+  (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
+  let toMillis :: Int -> Double
+      toMillis x = fromIntegral x / 1000.0
+  notice normal $ "File modification time resolution calibration completed, "
+    ++ "maximum delay observed: "
+    ++ (show . toMillis $ mtimeChange ) ++ " ms. "
+    ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange')
+    ++ " for test runs."
+  defaultMainWithIngredients
+         (includingOptions extraOptions : defaultIngredients)
+         (tests mtimeChange')

cabal-install/tests/UnitTests/Distribution/Client/Compat/Time.hs → Cabal/tests/UnitTests/Distribution/Compat/Time.hs

-module UnitTests.Distribution.Client.Compat.Time (tests) where
+module UnitTests.Distribution.Compat.Time (tests) where
 
 import Control.Concurrent (threadDelay)
 import System.FilePath
@@ -6,7 +6,7 @@ import System.FilePath
 import Distribution.Simple.Utils (withTempDirectory)
 import Distribution.Verbosity
 
-import Distribution.Client.Compat.Time
+import Distribution.Compat.Time
 
 import Test.Tasty
 import Test.Tasty.HUnit

cabal-install/Distribution/Client/FileMonitor.hs

@@ -58,7 +58,7 @@ import           Control.Monad.Except (ExceptT, runExceptT, withExceptT,
                                        throwError)
 import           Control.Exception
 
-import           Distribution.Client.Compat.Time
+import           Distribution.Compat.Time
 import           Distribution.Client.Glob
 import           Distribution.Simple.Utils (handleDoesNotExist, writeFileAtomic)
 import           Distribution.Client.Utils (mergeBy, MergeResult(..))

cabal-install/Distribution/Client/IndexUtils.hs

@@ -85,7 +85,7 @@ import Distribution.Client.GZipUtils (maybeDecompress)
 import Distribution.Client.Utils ( byteStringToFilePath
                                  , tryFindAddSourcePackageDesc )
 import Distribution.Compat.Exception (catchIO)
-import Distribution.Client.Compat.Time (getFileAge, getModTime)
+import Distribution.Compat.Time (getFileAge, getModTime)
 import System.Directory (doesFileExist, doesDirectoryExist)
 import System.FilePath
          ( (</>), takeExtension, replaceExtension, splitDirectories, normalise )

cabal-install/Distribution/Client/Sandbox/Timestamp.hs

@@ -55,7 +55,7 @@ import Distribution.Client.Utils
   (inDir, removeExistingFile, tryCanonicalizePath, tryFindAddSourcePackageDesc)
 
 import Distribution.Compat.Exception                 (catchIO)
-import Distribution.Client.Compat.Time               (ModTime, getCurTime,
+import Distribution.Compat.Time               (ModTime, getCurTime,
                                                       getModTime,
                                                       posixSecondsToModTime)
 

cabal-install/Distribution/Client/Utils.hs

@@ -19,7 +19,7 @@ module Distribution.Client.Utils ( MergeResult(..)
        where
 
 import Distribution.Compat.Exception   ( catchIO )
-import Distribution.Client.Compat.Time ( getModTime )
+import Distribution.Compat.Time ( getModTime )
 import Distribution.Simple.Setup       ( Flag(..) )
 import Distribution.Simple.Utils       ( die, findPackageDesc )
 import qualified Data.ByteString.Lazy as BS

cabal-install/cabal-install.cabal

@@ -211,7 +211,6 @@ executable cabal
         Distribution.Client.Compat.FilePerms
         Distribution.Client.Compat.Process
         Distribution.Client.Compat.Semaphore
-        Distribution.Client.Compat.Time
         Paths_cabal_install
 
     -- NOTE: when updating build-depends, don't forget to update version regexps
@@ -276,7 +275,6 @@ Test-Suite unit-tests
   other-modules:
     UnitTests.Distribution.Client.ArbitraryInstances
     UnitTests.Distribution.Client.Targets
-    UnitTests.Distribution.Client.Compat.Time
     UnitTests.Distribution.Client.Dependency.Modular.PSQ
     UnitTests.Distribution.Client.Dependency.Modular.Solver
     UnitTests.Distribution.Client.Dependency.Modular.DSL

cabal-install/tests/UnitTests.hs

@@ -5,16 +5,11 @@ module Main
 
 import Test.Tasty
 
-import Control.Monad
-import Data.Time.Clock
-import System.FilePath
-
 import Distribution.Simple.Utils
 import Distribution.Verbosity
 
-import Distribution.Client.Compat.Time
+import Distribution.Compat.Time
 
-import qualified UnitTests.Distribution.Client.Compat.Time
 import qualified UnitTests.Distribution.Client.Dependency.Modular.PSQ
 import qualified UnitTests.Distribution.Client.Dependency.Modular.Solver
 import qualified UnitTests.Distribution.Client.FileMonitor
@@ -38,9 +33,7 @@ tests mtimeChangeCalibrated =
                     else mtimeChangeCalibrated
   in
   testGroup "Unit Tests"
-  [ testGroup "UnitTests.Distribution.Client.Compat.Time" $
-        UnitTests.Distribution.Client.Compat.Time.tests mtimeChange
-  , testGroup "UnitTests.Distribution.Client.Dependency.Modular.PSQ"
+  [ testGroup "UnitTests.Distribution.Client.Dependency.Modular.PSQ"
         UnitTests.Distribution.Client.Dependency.Modular.PSQ.tests
   , testGroup "UnitTests.Distribution.Client.Dependency.Modular.Solver"
         UnitTests.Distribution.Client.Dependency.Modular.Solver.tests
@@ -66,41 +59,15 @@ tests mtimeChangeCalibrated =
 
 main :: IO ()
 main = do
-  mtimeChangeDelay <- calibrateMtimeChangeDelay
+  (mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
+  let toMillis :: Int -> Double
+      toMillis x = fromIntegral x / 1000.0
+  notice normal $ "File modification time resolution calibration completed, "
+    ++ "maximum delay observed: "
+    ++ (show . toMillis $ mtimeChange ) ++ " ms. "
+    ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange')
+    ++ " for test runs."
   defaultMainWithIngredients
          (includingOptions extraOptions : defaultIngredients)
-         (tests mtimeChangeDelay)
-
--- Based on code written by Neill Mitchell for Shake. See
--- 'sleepFileTimeCalibrate' in 'Test.Type'. The returned delay is never smaller
--- than 10 ms, but never larger than 1 second.
-calibrateMtimeChangeDelay :: IO Int
-calibrateMtimeChangeDelay = do
-  withTempDirectory silent "." "calibration-" $ \dir -> do
-    let fileName = dir </> "probe"
-    mtimes <- forM [1..25] $ \(i::Int) -> time $ do
-      writeFile fileName $ show i
-      t0 <- getModTime fileName
-      let spin j = do
-            writeFile fileName $ show (i,j)
-            t1 <- getModTime fileName
-            unless (t0 < t1) (spin $ j + 1)
-      spin (0::Int)
-    let mtimeChange  = maximum mtimes
-        mtimeChange' = min 1000000 $ (max 10000 mtimeChange) * 2
-    notice normal $ "File modification time resolution calibration completed, "
-      ++ "maximum delay observed: "
-      ++ (show . toMillis $ mtimeChange ) ++ " ms. "
-      ++ "Will be using delay of " ++ (show . toMillis $ mtimeChange')
-      ++ " for test runs."
-    return mtimeChange'
-  where
-    toMillis :: Int -> Double
-    toMillis x = fromIntegral x / 1000.0
+         (tests mtimeChange')
 
-    time :: IO () -> IO Int
-    time act = do
-      t0 <- getCurrentTime
-      act
-      t1 <- getCurrentTime
-      return . ceiling $! (t1 `diffUTCTime` t0) * 1e6 -- microseconds

cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs

@@ -15,7 +15,7 @@ import Distribution.Simple.Utils (withTempDirectory)
 import Distribution.Verbosity (silent)
 
 import Distribution.Client.FileMonitor
-import Distribution.Client.Compat.Time
+import Distribution.Compat.Time
 
 import Test.Tasty
 import Test.Tasty.HUnit

cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs

@@ -5,7 +5,7 @@ import System.FilePath
 import Distribution.Simple.Utils (withTempDirectory)
 import Distribution.Verbosity
 
-import Distribution.Client.Compat.Time
+import Distribution.Compat.Time
 import Distribution.Client.Sandbox.Timestamp
 
 import Test.Tasty