fix all remaining -Wall warnings on Windows

This commit is contained in:
Joey Hess 2014-02-25 14:09:39 -04:00
parent 360ecb9f35
commit 3f6e4b8c7c
13 changed files with 57 additions and 44 deletions

View file

@ -49,11 +49,13 @@ import Assistant.Threads.XMPPPusher
import Assistant.Types.UrlRenderer
#endif
import qualified Utility.Daemon
import Utility.LogFile
import Utility.ThreadScheduler
import Utility.HumanTime
import Annex.Perms
import qualified Build.SysConfig as SysConfig
#ifndef mingw32_HOST_OS
import Utility.LogFile
import Annex.Perms
#endif
import System.Log.Logger
import Network.Socket (HostName)
@ -70,8 +72,8 @@ startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName
startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
Annex.changeState $ \s -> s { Annex.daemon = True }
pidfile <- fromRepo gitAnnexPidFile
logfile <- fromRepo gitAnnexLogFile
#ifndef mingw32_HOST_OS
logfile <- fromRepo gitAnnexLogFile
createAnnexDirectory (parentDir logfile)
logfd <- liftIO $ openLog logfile
if foreground
@ -93,11 +95,12 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
#else
-- Windows is always foreground, and has no log file.
liftIO $ Utility.Daemon.lockPidFile pidfile
start id $ do
case startbrowser of
Nothing -> Nothing
Just a -> Just $ a Nothing Nothing
when (foreground || not foreground) $ do
liftIO $ Utility.Daemon.lockPidFile pidfile
start id $ do
case startbrowser of
Nothing -> Nothing
Just a -> Just $ a Nothing Nothing
#endif
where
desc

View file

@ -27,7 +27,6 @@ import qualified Git.Command
import qualified Git.Config
import Utility.ThreadScheduler
import qualified Assistant.Threads.Watcher as Watcher
import Utility.LogFile
import Utility.Batch
import Utility.NotificationBroadcaster
import Config
@ -43,6 +42,9 @@ import qualified Annex
#ifdef WITH_WEBAPP
import Assistant.WebApp.Types
#endif
#ifndef mingw32_HOST_OS
import Utility.LogFile
#endif
import Data.Time.Clock.POSIX
import qualified Data.Text as T
@ -214,10 +216,10 @@ checkLogSize n = do
checkLogSize $ n + 1
where
filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
#endif
oneMegabyte :: Int
oneMegabyte = 1000000
oneMegabyte :: Int
oneMegabyte = 1000000
#endif
oneHour :: Int
oneHour = 60 * 60

View file

@ -23,7 +23,6 @@ import Assistant.Types.Changes
import Assistant.Alert
import Utility.DirWatcher
import Utility.DirWatcher.Types
import qualified Utility.Lsof as Lsof
import qualified Annex
import qualified Annex.Queue
import qualified Git
@ -40,6 +39,9 @@ import Annex.ReplaceFile
import Git.Types
import Config
import Utility.ThreadScheduler
#ifndef mingw32_HOST_OS
import qualified Utility.Lsof as Lsof
#endif
import Data.Bits.Utils
import Data.Typeable

View file

@ -114,9 +114,9 @@ checkRepositoryPath p = do
- browsed to a directory with git-annex and run it from there. -}
defaultRepositoryPath :: Bool -> IO FilePath
defaultRepositoryPath firstrun = do
cwd <- liftIO getCurrentDirectory
home <- myHomeDir
#ifndef mingw32_HOST_OS
home <- myHomeDir
cwd <- liftIO getCurrentDirectory
if home == cwd && firstrun
then inhome
else ifM (legit cwd <&&> canWrite cwd)
@ -127,7 +127,7 @@ defaultRepositoryPath firstrun = do
-- On Windows, always default to ~/Desktop/annex or ~/annex,
-- no cwd handling because the user might be able to write
-- to the entire drive.
inhome
if firstrun then inhome else inhome
#endif
where
inhome = do
@ -136,9 +136,11 @@ defaultRepositoryPath firstrun = do
( relHome $ desktop </> gitAnnexAssistantDefaultDir
, return $ "~" </> gitAnnexAssistantDefaultDir
)
#ifndef mingw32_HOST_OS
-- Avoid using eg, standalone build's git-annex.linux/ directory
-- when run from there.
legit d = not <$> doesFileExist (d </> "git-annex")
#endif
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do

View file

@ -12,7 +12,6 @@ module Assistant.WebApp.Configurators.Pairing where
import Assistant.Pairing
import Assistant.WebApp.Common
import Assistant.WebApp.Configurators
import Assistant.Types.Buddies
import Annex.UUID
#ifdef WITH_PAIRING
@ -34,6 +33,9 @@ import Assistant.NetMessager
import Assistant.WebApp.RepoList
import Assistant.WebApp.Configurators.XMPP
#endif
#if defined(WITH_PAIRING) || defined(WITH_XMP)
import Assistant.WebApp.Configurators
#endif
import Utility.UserInfo
import Git

View file

@ -218,15 +218,15 @@ link file key mcache = flip catchAnnex (undo file key) $ do
l <- inRepo $ gitAnnexLink file key
replaceFile file $ makeAnnexLink l
#ifdef WITH_CLIBS
#ifndef __ANDROID__
-- touch symlink to have same time as the original file,
-- as provided in the InodeCache
case mcache of
#if defined(WITH_CLIBS) && ! defined(__ANDROID__)
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
#else
Just _ -> noop
#endif
Nothing -> noop
#endif
#endif
return l

View file

@ -466,7 +466,8 @@ getFsckTime key = do
- To guard against time stamp damange (for example, if an annex directory
- is copied without -a), the fsckstate file contains a time that should
- be identical to its modification time.
- (This is not possible to do on Windows.)
- (This is not possible to do on Windows, and so the timestamp in
- the file will only be equal or greater than the modification time.)
-}
recordStartTime :: Annex ()
recordStartTime = do
@ -477,10 +478,10 @@ recordStartTime = do
withFile f WriteMode $ \h -> do
#ifndef mingw32_HOST_OS
t <- modificationTime <$> getFileStatus f
hPutStr h $ showTime $ realToFrac t
#else
noop
t <- getPOSIXTime
#endif
hPutStr h $ showTime $ realToFrac t
where
showTime :: POSIXTime -> String
showTime = show
@ -494,15 +495,18 @@ getStartTime = do
f <- fromRepo gitAnnexFsckState
liftIO $ catchDefaultIO Nothing $ do
timestamp <- modificationTime <$> getFileStatus f
#ifndef mingw32_HOST_OS
t <- readishTime <$> readFile f
return $ if Just (realToFrac timestamp) == t
let fromstatus = Just (realToFrac timestamp)
fromfile <- readishTime <$> readFile f
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
#else
return $ Just timestamp
#endif
where
readishTime :: String -> Maybe POSIXTime
readishTime s = utcTimeToPOSIXSeconds <$>
parseTime defaultTimeLocale "%s%Qs" s
matchingtimestamp fromfile fromstatus =
#ifndef mingw32_HOST_OS
fromfile == fromstatus
#else
fromfile >= fromstatus
#endif

View file

@ -15,9 +15,6 @@ import Common
import Git
import Git.Types
import qualified Utility.CoProcess as CoProcess
#ifdef mingw32_HOST_OS
import Git.FilePath
#endif
import Utility.Batch
{- Constructs a git command line operating on the specified repo. -}

View file

@ -17,16 +17,17 @@ module Git.Queue (
flush,
) where
import qualified Data.Map as M
import System.IO
import System.Process
import Utility.SafeCommand
import Common
import Git
import Git.Command
import qualified Git.UpdateIndex
import qualified Data.Map as M
#ifndef mingw32_HOST_OS
import System.Process
#endif
{- Queable actions that can be performed in a git repository.
-}
data Action
@ -149,6 +150,7 @@ runAction repo (UpdateIndexAction streamers) =
Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers
runAction repo action@(CommandAction {}) =
#ifndef mingw32_HOST_OS
let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
withHandle StdinHandle createProcessSuccess p $ \h -> do
fileEncoding h
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
@ -162,6 +164,5 @@ runAction repo action@(CommandAction {}) =
void $ boolSystem "git" (gitparams ++ [f])
#endif
where
p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
gitparams = gitCommandLine
(Param (getSubcommand action):getParams action) repo

View file

@ -11,7 +11,9 @@ module Utility.LogFile where
import Common
#ifndef mingw32_HOST_OS
import System.Posix.Types
#endif
#ifndef mingw32_HOST_OS
openLog :: FilePath -> IO Fd

View file

@ -18,7 +18,6 @@ import Data.Char
import Control.Applicative
#ifdef mingw32_HOST_OS
import Data.Char
import qualified System.FilePath.Posix as Posix
#else
import System.Posix.Files

View file

@ -23,7 +23,6 @@ import Network.HTTP.Types
import System.Log.Logger
import qualified Data.CaseInsensitive as CI
import Network.Socket
import Control.Exception
import "crypto-api" Crypto.Random
import qualified Web.ClientSession as CS
import qualified Data.ByteString.Lazy as L
@ -39,6 +38,10 @@ import Control.Concurrent
#ifdef __ANDROID__
import Data.Endian
#endif
#if defined(__ANDROID__) || defined (mingw32_HOST_OS)
#else
import Control.Exception (bracketOnError)
#endif
localhost :: HostName
localhost = "localhost"

View file

@ -11,9 +11,5 @@ module Utility.WinProcess where
import Utility.PID
import System.Win32.Process
import Foreign.C
import Control.Exception
foreign import ccall unsafe "terminatepid"
terminatePID :: PID -> IO ()