fix all remaining -Wall warnings on Windows
This commit is contained in:
parent
360ecb9f35
commit
3f6e4b8c7c
13 changed files with 57 additions and 44 deletions
19
Assistant.hs
19
Assistant.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
11
Git/Queue.hs
11
Git/Queue.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Add table
Reference in a new issue