From 0d50a6105b5f00f52bc644c359fe4ea31bf31077 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 13 Dec 2012 00:45:27 -0400 Subject: [PATCH] whitespace fixes --- Annex/Branch.hs | 4 +- Assistant/Alert.hs | 4 +- Assistant/Pushes.hs | 2 +- Assistant/Threads/TransferWatcher.hs | 6 +-- Assistant/Threads/XMPPClient.hs | 2 +- Assistant/WebApp/Configurators/Pairing.hs | 6 +-- Assistant/WebApp/Types.hs | 46 +++++++++++------------ Command/Drop.hs | 2 +- Command/Fsck.hs | 2 +- Command/Import.hs | 2 +- Command/InitRemote.hs | 2 +- Command/Uninit.hs | 2 +- Command/Unlock.hs | 8 ++-- Command/WebApp.hs | 2 +- Config.hs | 2 +- Crypto.hs | 2 +- Git/Construct.hs | 2 +- Git/Sha.hs | 2 +- Init.hs | 6 +-- Logs/PreferredContent.hs | 2 +- Remote/Bup.hs | 2 +- Remote/Directory.hs | 2 +- Remote/Git.hs | 2 +- Remote/Glacier.hs | 2 +- Remote/Hook.hs | 2 +- Remote/Rsync.hs | 10 ++--- Remote/S3.hs | 2 +- Remote/WebDAV.hs | 10 ++--- Types/Command.hs | 6 +-- Utility/DirWatcher.hs | 43 ++++++++++----------- Utility/Gpg.hs | 2 +- Utility/JSONStream.hs | 6 +-- Utility/TempFile.hs | 2 +- 33 files changed, 97 insertions(+), 100 deletions(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index d0a74c7097..69b68cf7ac 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -116,7 +116,7 @@ updateTo pairs = do dirty <- journalDirty (refs, branches) <- unzip <$> filterM isnewer pairs if null refs - {- Even when no refs need to be merged, the index + {- Even when no refs need to be merged, the index - may still be updated if the branch has gotten ahead - of the index. -} then whenM (needUpdateIndex branchref) $ lockJournal $ do @@ -325,7 +325,7 @@ needUpdateIndex branchref = do - given ref of the branch. -} setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do - lock <- fromRepo gitAnnexIndexLock + lock <- fromRepo gitAnnexIndexLock liftIO $ writeFile lock $ show ref ++ "\n" setAnnexPerm lock diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index e953e1a5ea..c615b38efd 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -71,7 +71,7 @@ type AlertMap = M.Map AlertId Alert {- Higher AlertId indicates a more recent alert. -} newtype AlertId = AlertId Integer - deriving (Read, Show, Eq, Ord) + deriving (Read, Show, Eq, Ord) firstAlertId :: AlertId firstAlertId = AlertId 0 @@ -247,7 +247,7 @@ syncAlert rs = baseActivityAlert [Tensed "Syncing" "Synced", "with", showRemotes rs] , alertData = [] , alertPriority = Low - } + } scanAlert :: [Remote] -> Alert scanAlert rs = baseActivityAlert diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs index 9765b6a420..54f31a84bc 100644 --- a/Assistant/Pushes.hs +++ b/Assistant/Pushes.hs @@ -33,7 +33,7 @@ changeFailedPushMap a = do v <- getAssistant failedPushMap liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v where - {- tryTakeTMVar empties the TMVar; refill it only if + {- tryTakeTMVar empties the TMVar; refill it only if - the modified map is not itself empty -} store v m | m == M.empty = noop diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index 6f040ba910..d2f7ebe148 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -47,7 +47,7 @@ type Handler = FilePath -> Assistant () -} runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant () runHandler handler file _filestatus = - either (liftIO . print) (const noop) =<< tryIO <~> handler file + either (liftIO . print) (const noop) =<< tryIO <~> handler file {- Called when there's an error with inotify. -} onErr :: Handler @@ -97,8 +97,8 @@ onDel file = case parseTransferFile file of finished <- asIO2 finishedTransfer void $ liftIO $ forkIO $ do {- XXX race workaround delay. The location - - log needs to be updated before finishedTransfer - - runs. -} + - log needs to be updated before finishedTransfer + - runs. -} threadDelay 10000000 -- 10 seconds finished t minfo diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index df602df60f..99b46dabb4 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -55,7 +55,7 @@ xmppClient urlrenderer d = do inAssistant = liftIO . liftAssistant {- When the client exits, it's restarted; - - if it keeps failing, back off to wait 5 minutes before + - if it keeps failing, back off to wait 5 minutes before - trying it again. -} retry client starttime = do e <- client diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index 1ae73beaf9..6c89639ded 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -233,8 +233,8 @@ promptSecret msg cont = pairPage $ do ((result, form), enctype) <- lift $ runFormGet $ renderBootstrap $ InputSecret <$> aopt textField "Secret phrase" Nothing - case result of - FormSuccess v -> do + case result of + FormSuccess v -> do let rawsecret = fromMaybe "" $ secretText v let secret = toSecret rawsecret case msg of @@ -247,7 +247,7 @@ promptSecret msg cont = pairPage $ do then cont rawsecret secret else showform form enctype $ Just "That's not the right secret phrase." - _ -> showform form enctype Nothing + _ -> showform form enctype Nothing where showform form enctype mproblem = do let start = isNothing msg diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 71fcb6f246..a00279e18c 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -46,7 +46,7 @@ instance Yesod WebApp where isAuthorized _ _ = checkAuthToken secretToken {- Add the auth token to every url generated, except static subsite - - urls (which can show up in Permission Denied pages). -} + - urls (which can show up in Permission Denied pages). -} joinPath = insertAuthToken secretToken excludeStatic where excludeStatic [] = True @@ -90,45 +90,45 @@ data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector deriving (Read, Show, Eq) instance PathPiece SshData where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece NotificationId where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece AlertId where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece Transfer where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece PairMsg where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece SecretReminder where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece UUID where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece BuddyKey where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece PairKey where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece RepoListNotificationId where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack instance PathPiece RepoSelector where - toPathPiece = pack . show - fromPathPiece = readish . unpack + toPathPiece = pack . show + fromPathPiece = readish . unpack diff --git a/Command/Drop.hs b/Command/Drop.hs index a9eec78252..3a30703d52 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -79,7 +79,7 @@ performRemote key numcopies remote = lockContent key $ do stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do ok <- Remote.removeKey remote key next $ cleanupRemote key remote ok - where + where uuid = Remote.uuid remote cleanupLocal :: Key -> CommandCleanup diff --git a/Command/Fsck.hs b/Command/Fsck.hs index deb3a5c818..09f8b11364 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -206,7 +206,7 @@ fixLink key file = do return True {- Checks that the location log reflects the current status of the key, - in this repository only. -} + - in this repository only. -} verifyLocationLog :: Key -> String -> Annex Bool verifyLocationLog key desc = do present <- inAnnex key diff --git a/Command/Import.hs b/Command/Import.hs index e27a421f27..cf91f7b5ab 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -33,7 +33,7 @@ perform srcfile destfile = do unlessM (Annex.getState Annex.force) $ error $ "not overwriting existing " ++ destfile ++ " (use --force to override)" - + liftIO $ createDirectoryIfMissing True (parentDir destfile) liftIO $ moveFile srcfile destfile Command.Add.perform destfile diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 720fdddf5d..684f868efe 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -52,7 +52,7 @@ cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup cleanup u name c = do describeUUID u name Logs.Remote.configSet u c - return True + return True {- Look up existing remote's UUID and config by name, or generate a new one -} findByName :: String -> Annex (UUID, R.RemoteConfig) diff --git a/Command/Uninit.hs b/Command/Uninit.hs index a86044410a..37b3ff511f 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -19,7 +19,7 @@ import Annex.Content def :: [Command] def = [addCheck check $ command "uninit" paramPaths seek - "de-initialize git-annex and clean out repository"] + "de-initialize git-annex and clean out repository"] check :: Annex () check = do diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 6489fc333a..5a0e6efebb 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -39,12 +39,12 @@ perform dest key = do tmpdest <- fromRepo $ gitAnnexTmpLocation key liftIO $ createDirectoryIfMissing True (parentDir tmpdest) showAction "copying" - ok <- liftIO $ copyFileExternal src tmpdest - if ok - then do + ifM (liftIO $ copyFileExternal src tmpdest) + ( do liftIO $ do removeFile dest moveFile tmpdest dest thawContent dest next $ return True - else error "copy failed!" + , error "copy failed!" + ) diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 1d97eb304a..11ba23d83f 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -30,7 +30,7 @@ import Control.Concurrent.STM def :: [Command] def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ - command "webapp" paramNothing seek "launch webapp"] + command "webapp" paramNothing seek "launch webapp"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Config.hs b/Config.hs index 11b5f4c939..d6f240f184 100644 --- a/Config.hs +++ b/Config.hs @@ -27,7 +27,7 @@ setConfig (ConfigKey key) value = do {- Unsets a git config setting. (Leaves it in state currently.) -} unsetConfig :: ConfigKey -> Annex () unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config" - [Param "--unset", Param key] + [Param "--unset", Param key] {- Looks up a setting in git config. -} getConfig :: ConfigKey -> String -> Annex String diff --git a/Crypto.hs b/Crypto.hs index fe6c6d5cbf..bee793de21 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -93,7 +93,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c return $ EncryptedCipher encipher (KeyIds ks') - where + where recipients l = force_recipients : concatMap (\k -> [Param "--recipient", Param k]) l -- Force gpg to only encrypt to the specified diff --git a/Git/Construct.hs b/Git/Construct.hs index 4f6a63d864..bafb168748 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -125,7 +125,7 @@ remoteNamed n constructor = do return $ r { remoteName = Just n } {- Sets the name of a remote based on the git config key, such as - "remote.foo.url". -} + - "remote.foo.url". -} remoteNamedFromKey :: String -> IO Repo -> IO Repo remoteNamedFromKey k = remoteNamed basename where diff --git a/Git/Sha.hs b/Git/Sha.hs index e62b29dabd..ee1b6d6691 100644 --- a/Git/Sha.hs +++ b/Git/Sha.hs @@ -11,7 +11,7 @@ import Common import Git.Types {- Runs an action that causes a git subcommand to emit a Sha, and strips - any trailing newline, returning the sha. -} + - any trailing newline, returning the sha. -} getSha :: String -> IO String -> IO Sha getSha subcommand a = maybe bad return =<< extractSha <$> a where diff --git a/Init.hs b/Init.hs index effa61eacc..8222471797 100644 --- a/Init.hs +++ b/Init.hs @@ -47,9 +47,9 @@ uninitialize = do removeVersion {- Will automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git - repos that did not intend to use it. -} + - branch from somewhere. Otherwise, require a manual init + - to avoid git-annex accidentially being run in git + - repos that did not intend to use it. -} ensureInitialized :: Annex () ensureInitialized = getVersion >>= maybe needsinit checkVersion where diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index e0eb140b17..3340cf5ef7 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -91,7 +91,7 @@ makeMatcher :: GroupMap -> UUID -> String -> Utility.Matcher.Matcher MatchFiles makeMatcher groupmap u s | s == "standard" = standardMatcher groupmap u | null (lefts tokens) = Utility.Matcher.generate $ rights tokens - | otherwise = matchAll + | otherwise = matchAll where tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s) diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 116a433211..e14185017a 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -52,7 +52,7 @@ gen r u c = do { uuid = u' , cost = cst , name = Git.repoDescribe r - , storeKey = store r buprepo + , storeKey = store r buprepo , retrieveKeyFile = retrieve buprepo , retrieveKeyFileCheap = retrieveCheap buprepo , removeKey = remove diff --git a/Remote/Directory.hs b/Remote/Directory.hs index c202ddb1d2..946df6111d 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -45,7 +45,7 @@ gen r u c = do uuid = u, cost = cst, name = Git.repoDescribe r, - storeKey = store dir chunksize, + storeKey = store dir chunksize, retrieveKeyFile = retrieve dir chunksize, retrieveKeyFileCheap = retrieveCheap dir chunksize, removeKey = remove dir, diff --git a/Remote/Git.hs b/Remote/Git.hs index 0933a1caef..c30988cbf7 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -414,7 +414,7 @@ rsyncParams r = do o <- getRemoteConfig r "rsync-options" "" return $ options ++ map Param (words o) where - -- --inplace to resume partial files + -- --inplace to resume partial files options = [Params "-p --progress --inplace"] commitOnCleanup :: Git.Repo -> Annex a -> Annex a diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 0a41b0083b..05cdf8978f 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -49,7 +49,7 @@ gen r u c = new <$> remoteCost r veryExpensiveRemoteCost uuid = u, cost = cst, name = Git.repoDescribe r, - storeKey = store this, + storeKey = store this, retrieveKeyFile = retrieve this, retrieveKeyFileCheap = retrieveCheap this, removeKey = remove this, diff --git a/Remote/Hook.hs b/Remote/Hook.hs index e6e1231a8b..8f9aaafd62 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -40,7 +40,7 @@ gen r u c = do uuid = u, cost = cst, name = Git.repoDescribe r, - storeKey = store hooktype, + storeKey = store hooktype, retrieveKeyFile = retrieve hooktype, retrieveKeyFileCheap = retrieveCheap hooktype, removeKey = remove hooktype, diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 2ad5482ecf..4c61d8e622 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -49,7 +49,7 @@ gen r u c = do { uuid = u , cost = cst , name = Git.repoDescribe r - , storeKey = store o + , storeKey = store o , retrieveKeyFile = retrieve o , retrieveKeyFileCheap = retrieveCheap o , removeKey = remove o @@ -168,7 +168,7 @@ checkPresent r o k = do -- to connect, and the file not being present. Right <$> check where - check = untilTrue (rsyncUrls o k) $ \u -> + check = untilTrue (rsyncUrls o k) $ \u -> liftIO $ catchBoolIO $ do withQuietOutput createProcessSuccess $ proc "rsync" $ toCommand $ @@ -210,8 +210,8 @@ rsyncRemote o callback params = do ps = rsyncOptions o ++ defaultParams ++ params {- To send a single key is slightly tricky; need to build up a temporary - directory structure to pass to rsync so it can create the hash - directories. -} + - directory structure to pass to rsync so it can create the hash + - directories. -} rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> FilePath -> Annex Bool rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do let dest = tmp Prelude.head (keyPaths k) @@ -220,7 +220,7 @@ rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do rsyncRemote o (Just callback) [ Param "--recursive" , partialParams - -- tmp/ to send contents of tmp dir + -- tmp/ to send contents of tmp dir , Param $ addTrailingPathSeparator tmp , Param $ rsyncUrl o ] diff --git a/Remote/S3.hs b/Remote/S3.hs index e50145f616..345d938724 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -49,7 +49,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost uuid = u, cost = cst, name = Git.repoDescribe r, - storeKey = store this, + storeKey = store this, retrieveKeyFile = retrieve this, retrieveKeyFileCheap = retrieveCheap this, removeKey = remove this, diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 391027d788..70faa75392 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -55,7 +55,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost uuid = u, cost = cst, name = Git.repoDescribe r, - storeKey = store this, + storeKey = store this, retrieveKeyFile = retrieve this, retrieveKeyFileCheap = retrieveCheap this, removeKey = remove this, @@ -314,10 +314,10 @@ getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u) davCreds :: UUID -> CredPairStorage davCreds u = CredPairStorage - { credPairFile = fromUUID u - , credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD") - , credPairRemoteKey = Just "davcreds" - } + { credPairFile = fromUUID u + , credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD") + , credPairRemoteKey = Just "davcreds" + } setCredsEnv :: (String, String) -> IO () setCredsEnv creds = setEnvCredPair creds $ davCreds undefined diff --git a/Types/Command.hs b/Types/Command.hs index 24413ebadc..b652bdad59 100644 --- a/Types/Command.hs +++ b/Types/Command.hs @@ -22,9 +22,9 @@ data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () } - a list of start stage actions. -} type CommandSeek = [String] -> Annex [CommandStart] {- c. The start stage is run before anything is printed about the - - command, is passed some input, and can early abort it - - if the input does not make sense. It should run quickly and - - should not modify Annex state. -} + - command, is passed some input, and can early abort it + - if the input does not make sense. It should run quickly and + - should not modify Annex state. -} type CommandStart = Annex (Maybe CommandPerform) {- d. The perform stage is run after a message is printed about the command - being run, and it should be where the bulk of the work happens. -} diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs index b70e84b777..d564f8bcf0 100644 --- a/Utility/DirWatcher.hs +++ b/Utility/DirWatcher.hs @@ -35,13 +35,12 @@ canWatch = True canWatch = False #endif -/* With inotify, discrete events will be received when making multiple changes - * to the same filename. For example, adding it, deleting it, and adding it - * again will be three events. - * - * OTOH, with kqueue, often only one event is received, indicating the most - * recent state of the file. - */ +{- With inotify, discrete events will be received when making multiple changes + - to the same filename. For example, adding it, deleting it, and adding it + - again will be three events. + - + - OTOH, with kqueue, often only one event is received, indicating the most + - recent state of the file. -} eventsCoalesce :: Bool #if WITH_INOTIFY eventsCoalesce = False @@ -53,14 +52,13 @@ eventsCoalesce = undefined #endif #endif -/* With inotify, file closing is tracked to some extent, so an add event - * will always be received for a file once its writer closes it, and - * (typically) not before. This may mean multiple add events for the same file. - * - * OTOH, with kqueue, add events will often be received while a file is - * still being written to, and then no add event will be received once the - * writer closes it. - */ +{- With inotify, file closing is tracked to some extent, so an add event + - will always be received for a file once its writer closes it, and + - (typically) not before. This may mean multiple add events for the same file. + - + - OTOH, with kqueue, add events will often be received while a file is + - still being written to, and then no add event will be received once the + - writer closes it. -} closingTracked :: Bool #if WITH_INOTIFY closingTracked = True @@ -72,9 +70,8 @@ closingTracked = undefined #endif #endif -/* With inotify, modifications to existing files can be tracked. - * Kqueue does not support this. - */ +{- With inotify, modifications to existing files can be tracked. + - Kqueue does not support this. -} modifyTracked :: Bool #if WITH_INOTIFY modifyTracked = True @@ -86,11 +83,11 @@ modifyTracked = undefined #endif #endif -/* Starts a watcher thread. The runStartup action is passed a scanner action - * to run, that will return once the initial directory scan is complete. - * Once runStartup returns, the watcher thread continues running, - * and processing events. Returns a DirWatcherHandle that can be used - * to shutdown later. */ +{- Starts a watcher thread. The runStartup action is passed a scanner action + - to run, that will return once the initial directory scan is complete. + - Once runStartup returns, the watcher thread continues running, + - and processing events. Returns a DirWatcherHandle that can be used + - to shutdown later. -} #if WITH_INOTIFY type DirWatcherHandle = INotify.INotify watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 8c7a3ac386..ca017ed3ae 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -16,7 +16,7 @@ import System.Posix.Env (setEnv, unsetEnv, getEnv) import Common newtype KeyIds = KeyIds [String] - deriving (Ord, Eq) + deriving (Ord, Eq) stdParams :: [CommandParam] -> IO [String] stdParams params = do diff --git a/Utility/JSONStream.hs b/Utility/JSONStream.hs index aaa332bcae..f3e93c3dac 100644 --- a/Utility/JSONStream.hs +++ b/Utility/JSONStream.hs @@ -14,9 +14,9 @@ module Utility.JSONStream ( import Text.JSON {- Text.JSON does not support building up a larger JSON document piece by - piece as a stream. To support streaming, a hack. The JSObject is converted - to a string with its final "}" is left off, allowing it to be added to - later. -} + - piece as a stream. To support streaming, a hack. The JSObject is converted + - to a string with its final "}" is left off, allowing it to be added to + - later. -} start :: JSON a => [(String, a)] -> String start l | last s == endchar = init s diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs index 688baa4919..6dbea693ab 100644 --- a/Utility/TempFile.hs +++ b/Utility/TempFile.hs @@ -22,7 +22,7 @@ import System.FilePath viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO () viaTmp a file content = do pid <- getProcessID - let tmpfile = file ++ ".tmp" ++ show pid + let tmpfile = file ++ ".tmp" ++ show pid createDirectoryIfMissing True (parentDir file) a tmpfile content renameFile tmpfile file