move old ghc compat code into separate module; eliminate WITH_CLIBS
This avoids hsc2hs being run except when building for the old version of ghc. Should speed up builds.
This commit is contained in:
parent
a665f92b91
commit
40207b26ea
7 changed files with 61 additions and 57 deletions
|
@ -5,8 +5,6 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
|
|
||||||
module Annex.Ingest (
|
module Annex.Ingest (
|
||||||
LockedDown(..),
|
LockedDown(..),
|
||||||
LockDownConfig(..),
|
LockDownConfig(..),
|
||||||
|
@ -38,13 +36,9 @@ import Utility.InodeCache
|
||||||
import Annex.ReplaceFile
|
import Annex.ReplaceFile
|
||||||
import Utility.Tmp
|
import Utility.Tmp
|
||||||
import Utility.CopyFile
|
import Utility.CopyFile
|
||||||
|
import Utility.Touch
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
import Annex.InodeSentinal
|
import Annex.InodeSentinal
|
||||||
#ifdef WITH_CLIBS
|
|
||||||
#ifndef __ANDROID__
|
|
||||||
import Utility.Touch
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import Control.Exception (IOException)
|
import Control.Exception (IOException)
|
||||||
|
|
||||||
|
@ -260,11 +254,7 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
|
||||||
-- touch symlink to have same time as the original file,
|
-- touch symlink to have same time as the original file,
|
||||||
-- as provided in the InodeCache
|
-- as provided in the InodeCache
|
||||||
case mcache of
|
case mcache of
|
||||||
#if defined(WITH_CLIBS) && ! defined(__ANDROID__)
|
|
||||||
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
|
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
|
||||||
#else
|
|
||||||
Just _ -> noop
|
|
||||||
#endif
|
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
|
|
||||||
return l
|
return l
|
||||||
|
|
|
@ -25,7 +25,7 @@ import Assistant.Threads.RemoteControl
|
||||||
import Assistant.Threads.SanityChecker
|
import Assistant.Threads.SanityChecker
|
||||||
import Assistant.Threads.Cronner
|
import Assistant.Threads.Cronner
|
||||||
import Assistant.Threads.ProblemFixer
|
import Assistant.Threads.ProblemFixer
|
||||||
#ifdef WITH_CLIBS
|
#ifndef mingw32_HOST_OS
|
||||||
import Assistant.Threads.MountWatcher
|
import Assistant.Threads.MountWatcher
|
||||||
#endif
|
#endif
|
||||||
import Assistant.Threads.NetWatcher
|
import Assistant.Threads.NetWatcher
|
||||||
|
@ -170,7 +170,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
|
||||||
, assist $ sanityCheckerDailyThread urlrenderer
|
, assist $ sanityCheckerDailyThread urlrenderer
|
||||||
, assist sanityCheckerHourlyThread
|
, assist sanityCheckerHourlyThread
|
||||||
, assist $ problemFixerThread urlrenderer
|
, assist $ problemFixerThread urlrenderer
|
||||||
#ifdef WITH_CLIBS
|
#ifndef mingw32_HOST_OS
|
||||||
, assist $ mountWatcherThread urlrenderer
|
, assist $ mountWatcherThread urlrenderer
|
||||||
#endif
|
#endif
|
||||||
, assist netWatcherThread
|
, assist netWatcherThread
|
||||||
|
|
|
@ -24,9 +24,7 @@ import qualified Git.Branch
|
||||||
import Config.Files
|
import Config.Files
|
||||||
import Utility.FreeDesktop
|
import Utility.FreeDesktop
|
||||||
import Utility.DiskFree
|
import Utility.DiskFree
|
||||||
#ifdef WITH_CLIBS
|
|
||||||
import Utility.Mounts
|
import Utility.Mounts
|
||||||
#endif
|
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Remote (prettyUUID)
|
import Remote (prettyUUID)
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
@ -359,7 +357,6 @@ driveList :: IO [RemovableDrive]
|
||||||
-- Could use wmic, but it only works for administrators.
|
-- Could use wmic, but it only works for administrators.
|
||||||
driveList = mapM (\d -> genRemovableDrive $ d:":\\") ['A'..'Z']
|
driveList = mapM (\d -> genRemovableDrive $ d:":\\") ['A'..'Z']
|
||||||
#else
|
#else
|
||||||
#ifdef WITH_CLIBS
|
|
||||||
driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts
|
driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts
|
||||||
where
|
where
|
||||||
-- filter out some things that are surely not removable drives
|
-- filter out some things that are surely not removable drives
|
||||||
|
@ -379,9 +376,6 @@ driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts
|
||||||
| dir == "/sdcard" = False
|
| dir == "/sdcard" = False
|
||||||
#endif
|
#endif
|
||||||
| otherwise = True
|
| otherwise = True
|
||||||
#else
|
|
||||||
driveList = return []
|
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
genRemovableDrive :: FilePath -> IO RemovableDrive
|
genRemovableDrive :: FilePath -> IO RemovableDrive
|
||||||
|
|
|
@ -18,11 +18,7 @@ import Annex.Content
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
import qualified Annex.Queue
|
import qualified Annex.Queue
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
#ifdef WITH_CLIBS
|
|
||||||
#ifndef __ANDROID__
|
|
||||||
import Utility.Touch
|
import Utility.Touch
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
|
cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $
|
||||||
|
@ -90,20 +86,16 @@ makeHardLink file key = do
|
||||||
fixSymlink :: FilePath -> FilePath -> CommandPerform
|
fixSymlink :: FilePath -> FilePath -> CommandPerform
|
||||||
fixSymlink file link = do
|
fixSymlink file link = do
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
#ifdef WITH_CLIBS
|
#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__)
|
||||||
#ifndef __ANDROID__
|
|
||||||
-- preserve mtime of symlink
|
-- preserve mtime of symlink
|
||||||
mtime <- catchMaybeIO $ TimeSpec . modificationTime
|
mtime <- catchMaybeIO $ TimeSpec . modificationTime
|
||||||
<$> getSymbolicLinkStatus file
|
<$> getSymbolicLinkStatus file
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
createDirectoryIfMissing True (parentDir file)
|
createDirectoryIfMissing True (parentDir file)
|
||||||
removeFile file
|
removeFile file
|
||||||
createSymbolicLink link file
|
createSymbolicLink link file
|
||||||
#ifdef WITH_CLIBS
|
#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__)
|
||||||
#ifndef __ANDROID__
|
|
||||||
maybe noop (\t -> touch file t False) mtime
|
maybe noop (\t -> touch file t False) mtime
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
next $ cleanupSymlink file
|
next $ cleanupSymlink file
|
||||||
|
|
||||||
|
|
52
Utility/Touch.hs
Normal file
52
Utility/Touch.hs
Normal file
|
@ -0,0 +1,52 @@
|
||||||
|
{- More control over touching a file.
|
||||||
|
-
|
||||||
|
- Copyright 2011 Joey Hess <id@joeyh.name>
|
||||||
|
-
|
||||||
|
- License: BSD-2-clause
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
|
module Utility.Touch (
|
||||||
|
TimeSpec(..),
|
||||||
|
touchBoth,
|
||||||
|
touch
|
||||||
|
) where
|
||||||
|
|
||||||
|
#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__)
|
||||||
|
|
||||||
|
#if MIN_VERSION_unix(2,7,0)
|
||||||
|
|
||||||
|
import System.Posix.Files
|
||||||
|
import System.Posix.Types
|
||||||
|
|
||||||
|
newtype TimeSpec = TimeSpec EpochTime
|
||||||
|
|
||||||
|
{- Changes the access and modification times of an existing file.
|
||||||
|
Can follow symlinks, or not. Throws IO error on failure. -}
|
||||||
|
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
|
||||||
|
touchBoth file (TimeSpec atime) (TimeSpec mtime) follow
|
||||||
|
| follow = setFileTimes file atime mtime
|
||||||
|
| otherwise = setSymbolicLinkTimesHiRes file (realToFrac atime) (realToFrac mtime)
|
||||||
|
|
||||||
|
touch :: FilePath -> TimeSpec -> Bool -> IO ()
|
||||||
|
touch file mtime = touchBoth file mtime mtime
|
||||||
|
|
||||||
|
#else
|
||||||
|
import Utility.Touch.Old
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
import System.PosixCompat
|
||||||
|
|
||||||
|
newtype TimeSpec = TimeSpec EpochTime
|
||||||
|
|
||||||
|
{- Noop for Windows -}
|
||||||
|
touchBoth FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
|
||||||
|
touchBoth _ _ _ _ = return ()
|
||||||
|
|
||||||
|
touch :: FilePath -> TimeSpec -> Bool -> IO ()
|
||||||
|
touch _ _ = return ()
|
||||||
|
|
||||||
|
#endif
|
|
@ -1,4 +1,4 @@
|
||||||
{- More control over touching a file.
|
{- Compatability interface for old version of unix, to be removed eventally.
|
||||||
-
|
-
|
||||||
- Copyright 2011 Joey Hess <id@joeyh.name>
|
- Copyright 2011 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
|
@ -7,32 +7,12 @@
|
||||||
|
|
||||||
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
|
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
|
||||||
|
|
||||||
module Utility.Touch (
|
module Utility.Touch.Old (
|
||||||
TimeSpec(..),
|
TimeSpec(..),
|
||||||
touchBoth,
|
touchBoth,
|
||||||
touch
|
touch
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#if MIN_VERSION_unix(2,7,0)
|
|
||||||
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.Posix.Types
|
|
||||||
|
|
||||||
newtype TimeSpec = TimeSpec EpochTime
|
|
||||||
|
|
||||||
{- Changes the access and modification times of an existing file.
|
|
||||||
Can follow symlinks, or not. Throws IO error on failure. -}
|
|
||||||
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
|
|
||||||
touchBoth file (TimeSpec atime) (TimeSpec mtime) follow
|
|
||||||
| follow = setFileTimes file atime mtime
|
|
||||||
| otherwise = setSymbolicLinkTimesHiRes file (realToFrac atime) (realToFrac mtime)
|
|
||||||
|
|
||||||
touch :: FilePath -> TimeSpec -> Bool -> IO ()
|
|
||||||
touch file mtime = touchBoth file mtime mtime
|
|
||||||
|
|
||||||
#else
|
|
||||||
{- Compatability interface for old version of unix, to be removed eventally. -}
|
|
||||||
|
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/stat.h>
|
#include <sys/stat.h>
|
||||||
#include <fcntl.h>
|
#include <fcntl.h>
|
||||||
|
@ -141,5 +121,3 @@ touchBoth file atime mtime follow =
|
||||||
touchBoth _ _ _ _ = return ()
|
touchBoth _ _ _ _ = return ()
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#endif
|
|
|
@ -144,10 +144,8 @@ Executable git-annex
|
||||||
process (>= 1.3.0.0)
|
process (>= 1.3.0.0)
|
||||||
else
|
else
|
||||||
Build-Depends: unix
|
Build-Depends: unix
|
||||||
-- Need to list these because they're generated from .hsc files.
|
if impl(ghc <= 7.6.3)
|
||||||
Other-Modules: Utility.Touch
|
Other-Modules: Utility.Touch.Old
|
||||||
Include-Dirs: Utility
|
|
||||||
CPP-Options: -DWITH_CLIBS
|
|
||||||
|
|
||||||
if flag(TestSuite)
|
if flag(TestSuite)
|
||||||
Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun,
|
Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun,
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue