whitespace fixes

This commit is contained in:
Joey Hess 2012-12-13 00:45:27 -04:00
parent f87a781aa6
commit 0d50a6105b
33 changed files with 97 additions and 100 deletions

View file

@ -116,7 +116,7 @@ updateTo pairs = do
dirty <- journalDirty dirty <- journalDirty
(refs, branches) <- unzip <$> filterM isnewer pairs (refs, branches) <- unzip <$> filterM isnewer pairs
if null refs 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 - may still be updated if the branch has gotten ahead
- of the index. -} - of the index. -}
then whenM (needUpdateIndex branchref) $ lockJournal $ do then whenM (needUpdateIndex branchref) $ lockJournal $ do
@ -325,7 +325,7 @@ needUpdateIndex branchref = do
- given ref of the branch. -} - given ref of the branch. -}
setIndexSha :: Git.Ref -> Annex () setIndexSha :: Git.Ref -> Annex ()
setIndexSha ref = do setIndexSha ref = do
lock <- fromRepo gitAnnexIndexLock lock <- fromRepo gitAnnexIndexLock
liftIO $ writeFile lock $ show ref ++ "\n" liftIO $ writeFile lock $ show ref ++ "\n"
setAnnexPerm lock setAnnexPerm lock

View file

@ -71,7 +71,7 @@ type AlertMap = M.Map AlertId Alert
{- Higher AlertId indicates a more recent alert. -} {- Higher AlertId indicates a more recent alert. -}
newtype AlertId = AlertId Integer newtype AlertId = AlertId Integer
deriving (Read, Show, Eq, Ord) deriving (Read, Show, Eq, Ord)
firstAlertId :: AlertId firstAlertId :: AlertId
firstAlertId = AlertId 0 firstAlertId = AlertId 0
@ -247,7 +247,7 @@ syncAlert rs = baseActivityAlert
[Tensed "Syncing" "Synced", "with", showRemotes rs] [Tensed "Syncing" "Synced", "with", showRemotes rs]
, alertData = [] , alertData = []
, alertPriority = Low , alertPriority = Low
} }
scanAlert :: [Remote] -> Alert scanAlert :: [Remote] -> Alert
scanAlert rs = baseActivityAlert scanAlert rs = baseActivityAlert

View file

@ -33,7 +33,7 @@ changeFailedPushMap a = do
v <- getAssistant failedPushMap v <- getAssistant failedPushMap
liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v
where where
{- tryTakeTMVar empties the TMVar; refill it only if {- tryTakeTMVar empties the TMVar; refill it only if
- the modified map is not itself empty -} - the modified map is not itself empty -}
store v m store v m
| m == M.empty = noop | m == M.empty = noop

View file

@ -47,7 +47,7 @@ type Handler = FilePath -> Assistant ()
-} -}
runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant () runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
runHandler handler file _filestatus = 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. -} {- Called when there's an error with inotify. -}
onErr :: Handler onErr :: Handler
@ -97,8 +97,8 @@ onDel file = case parseTransferFile file of
finished <- asIO2 finishedTransfer finished <- asIO2 finishedTransfer
void $ liftIO $ forkIO $ do void $ liftIO $ forkIO $ do
{- XXX race workaround delay. The location {- XXX race workaround delay. The location
- log needs to be updated before finishedTransfer - log needs to be updated before finishedTransfer
- runs. -} - runs. -}
threadDelay 10000000 -- 10 seconds threadDelay 10000000 -- 10 seconds
finished t minfo finished t minfo

View file

@ -55,7 +55,7 @@ xmppClient urlrenderer d = do
inAssistant = liftIO . liftAssistant inAssistant = liftIO . liftAssistant
{- When the client exits, it's restarted; {- 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. -} - trying it again. -}
retry client starttime = do retry client starttime = do
e <- client e <- client

View file

@ -233,8 +233,8 @@ promptSecret msg cont = pairPage $ do
((result, form), enctype) <- lift $ ((result, form), enctype) <- lift $
runFormGet $ renderBootstrap $ runFormGet $ renderBootstrap $
InputSecret <$> aopt textField "Secret phrase" Nothing InputSecret <$> aopt textField "Secret phrase" Nothing
case result of case result of
FormSuccess v -> do FormSuccess v -> do
let rawsecret = fromMaybe "" $ secretText v let rawsecret = fromMaybe "" $ secretText v
let secret = toSecret rawsecret let secret = toSecret rawsecret
case msg of case msg of
@ -247,7 +247,7 @@ promptSecret msg cont = pairPage $ do
then cont rawsecret secret then cont rawsecret secret
else showform form enctype $ Just else showform form enctype $ Just
"That's not the right secret phrase." "That's not the right secret phrase."
_ -> showform form enctype Nothing _ -> showform form enctype Nothing
where where
showform form enctype mproblem = do showform form enctype mproblem = do
let start = isNothing msg let start = isNothing msg

View file

@ -46,7 +46,7 @@ instance Yesod WebApp where
isAuthorized _ _ = checkAuthToken secretToken isAuthorized _ _ = checkAuthToken secretToken
{- Add the auth token to every url generated, except static subsite {- 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 joinPath = insertAuthToken secretToken excludeStatic
where where
excludeStatic [] = True excludeStatic [] = True
@ -90,45 +90,45 @@ data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector
deriving (Read, Show, Eq) deriving (Read, Show, Eq)
instance PathPiece SshData where instance PathPiece SshData where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece NotificationId where instance PathPiece NotificationId where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece AlertId where instance PathPiece AlertId where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece Transfer where instance PathPiece Transfer where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece PairMsg where instance PathPiece PairMsg where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece SecretReminder where instance PathPiece SecretReminder where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece UUID where instance PathPiece UUID where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece BuddyKey where instance PathPiece BuddyKey where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece PairKey where instance PathPiece PairKey where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece RepoListNotificationId where instance PathPiece RepoListNotificationId where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack
instance PathPiece RepoSelector where instance PathPiece RepoSelector where
toPathPiece = pack . show toPathPiece = pack . show
fromPathPiece = readish . unpack fromPathPiece = readish . unpack

View file

@ -79,7 +79,7 @@ performRemote key numcopies remote = lockContent key $ do
stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do
ok <- Remote.removeKey remote key ok <- Remote.removeKey remote key
next $ cleanupRemote key remote ok next $ cleanupRemote key remote ok
where where
uuid = Remote.uuid remote uuid = Remote.uuid remote
cleanupLocal :: Key -> CommandCleanup cleanupLocal :: Key -> CommandCleanup

View file

@ -206,7 +206,7 @@ fixLink key file = do
return True return True
{- Checks that the location log reflects the current status of the key, {- 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 -> String -> Annex Bool
verifyLocationLog key desc = do verifyLocationLog key desc = do
present <- inAnnex key present <- inAnnex key

View file

@ -33,7 +33,7 @@ perform srcfile destfile = do
unlessM (Annex.getState Annex.force) $ unlessM (Annex.getState Annex.force) $
error $ "not overwriting existing " ++ destfile ++ error $ "not overwriting existing " ++ destfile ++
" (use --force to override)" " (use --force to override)"
liftIO $ createDirectoryIfMissing True (parentDir destfile) liftIO $ createDirectoryIfMissing True (parentDir destfile)
liftIO $ moveFile srcfile destfile liftIO $ moveFile srcfile destfile
Command.Add.perform destfile Command.Add.perform destfile

View file

@ -52,7 +52,7 @@ cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
cleanup u name c = do cleanup u name c = do
describeUUID u name describeUUID u name
Logs.Remote.configSet u c Logs.Remote.configSet u c
return True return True
{- Look up existing remote's UUID and config by name, or generate a new one -} {- Look up existing remote's UUID and config by name, or generate a new one -}
findByName :: String -> Annex (UUID, R.RemoteConfig) findByName :: String -> Annex (UUID, R.RemoteConfig)

View file

@ -19,7 +19,7 @@ import Annex.Content
def :: [Command] def :: [Command]
def = [addCheck check $ command "uninit" paramPaths seek 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 :: Annex ()
check = do check = do

View file

@ -39,12 +39,12 @@ perform dest key = do
tmpdest <- fromRepo $ gitAnnexTmpLocation key tmpdest <- fromRepo $ gitAnnexTmpLocation key
liftIO $ createDirectoryIfMissing True (parentDir tmpdest) liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
showAction "copying" showAction "copying"
ok <- liftIO $ copyFileExternal src tmpdest ifM (liftIO $ copyFileExternal src tmpdest)
if ok ( do
then do
liftIO $ do liftIO $ do
removeFile dest removeFile dest
moveFile tmpdest dest moveFile tmpdest dest
thawContent dest thawContent dest
next $ return True next $ return True
else error "copy failed!" , error "copy failed!"
)

View file

@ -30,7 +30,7 @@ import Control.Concurrent.STM
def :: [Command] def :: [Command]
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
command "webapp" paramNothing seek "launch webapp"] command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withNothing start] seek = [withNothing start]

View file

@ -27,7 +27,7 @@ setConfig (ConfigKey key) value = do
{- Unsets a git config setting. (Leaves it in state currently.) -} {- Unsets a git config setting. (Leaves it in state currently.) -}
unsetConfig :: ConfigKey -> Annex () unsetConfig :: ConfigKey -> Annex ()
unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config" unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config"
[Param "--unset", Param key] [Param "--unset", Param key]
{- Looks up a setting in git config. -} {- Looks up a setting in git config. -}
getConfig :: ConfigKey -> String -> Annex String getConfig :: ConfigKey -> String -> Annex String

View file

@ -93,7 +93,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do
let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c
return $ EncryptedCipher encipher (KeyIds ks') return $ EncryptedCipher encipher (KeyIds ks')
where where
recipients l = force_recipients : recipients l = force_recipients :
concatMap (\k -> [Param "--recipient", Param k]) l concatMap (\k -> [Param "--recipient", Param k]) l
-- Force gpg to only encrypt to the specified -- Force gpg to only encrypt to the specified

View file

@ -125,7 +125,7 @@ remoteNamed n constructor = do
return $ r { remoteName = Just n } return $ r { remoteName = Just n }
{- Sets the name of a remote based on the git config key, such as {- 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 :: String -> IO Repo -> IO Repo
remoteNamedFromKey k = remoteNamed basename remoteNamedFromKey k = remoteNamed basename
where where

View file

@ -11,7 +11,7 @@ import Common
import Git.Types import Git.Types
{- Runs an action that causes a git subcommand to emit a Sha, and strips {- 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 :: String -> IO String -> IO Sha
getSha subcommand a = maybe bad return =<< extractSha <$> a getSha subcommand a = maybe bad return =<< extractSha <$> a
where where

View file

@ -47,9 +47,9 @@ uninitialize = do
removeVersion removeVersion
{- Will automatically initialize if there is already a git-annex {- Will automatically initialize if there is already a git-annex
branch from somewhere. Otherwise, require a manual init - branch from somewhere. Otherwise, require a manual init
to avoid git-annex accidentially being run in git - to avoid git-annex accidentially being run in git
repos that did not intend to use it. -} - repos that did not intend to use it. -}
ensureInitialized :: Annex () ensureInitialized :: Annex ()
ensureInitialized = getVersion >>= maybe needsinit checkVersion ensureInitialized = getVersion >>= maybe needsinit checkVersion
where where

View file

@ -91,7 +91,7 @@ makeMatcher :: GroupMap -> UUID -> String -> Utility.Matcher.Matcher MatchFiles
makeMatcher groupmap u s makeMatcher groupmap u s
| s == "standard" = standardMatcher groupmap u | s == "standard" = standardMatcher groupmap u
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens | null (lefts tokens) = Utility.Matcher.generate $ rights tokens
| otherwise = matchAll | otherwise = matchAll
where where
tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s) tokens = map (parseToken (Just u) groupmap) (tokenizeMatcher s)

View file

@ -52,7 +52,7 @@ gen r u c = do
{ uuid = u' { uuid = u'
, cost = cst , cost = cst
, name = Git.repoDescribe r , name = Git.repoDescribe r
, storeKey = store r buprepo , storeKey = store r buprepo
, retrieveKeyFile = retrieve buprepo , retrieveKeyFile = retrieve buprepo
, retrieveKeyFileCheap = retrieveCheap buprepo , retrieveKeyFileCheap = retrieveCheap buprepo
, removeKey = remove , removeKey = remove

View file

@ -45,7 +45,7 @@ gen r u c = do
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store dir chunksize, storeKey = store dir chunksize,
retrieveKeyFile = retrieve dir chunksize, retrieveKeyFile = retrieve dir chunksize,
retrieveKeyFileCheap = retrieveCheap dir chunksize, retrieveKeyFileCheap = retrieveCheap dir chunksize,
removeKey = remove dir, removeKey = remove dir,

View file

@ -414,7 +414,7 @@ rsyncParams r = do
o <- getRemoteConfig r "rsync-options" "" o <- getRemoteConfig r "rsync-options" ""
return $ options ++ map Param (words o) return $ options ++ map Param (words o)
where where
-- --inplace to resume partial files -- --inplace to resume partial files
options = [Params "-p --progress --inplace"] options = [Params "-p --progress --inplace"]
commitOnCleanup :: Git.Repo -> Annex a -> Annex a commitOnCleanup :: Git.Repo -> Annex a -> Annex a

View file

@ -49,7 +49,7 @@ gen r u c = new <$> remoteCost r veryExpensiveRemoteCost
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store this, storeKey = store this,
retrieveKeyFile = retrieve this, retrieveKeyFile = retrieve this,
retrieveKeyFileCheap = retrieveCheap this, retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this, removeKey = remove this,

View file

@ -40,7 +40,7 @@ gen r u c = do
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store hooktype, storeKey = store hooktype,
retrieveKeyFile = retrieve hooktype, retrieveKeyFile = retrieve hooktype,
retrieveKeyFileCheap = retrieveCheap hooktype, retrieveKeyFileCheap = retrieveCheap hooktype,
removeKey = remove hooktype, removeKey = remove hooktype,

View file

@ -49,7 +49,7 @@ gen r u c = do
{ uuid = u { uuid = u
, cost = cst , cost = cst
, name = Git.repoDescribe r , name = Git.repoDescribe r
, storeKey = store o , storeKey = store o
, retrieveKeyFile = retrieve o , retrieveKeyFile = retrieve o
, retrieveKeyFileCheap = retrieveCheap o , retrieveKeyFileCheap = retrieveCheap o
, removeKey = remove o , removeKey = remove o
@ -168,7 +168,7 @@ checkPresent r o k = do
-- to connect, and the file not being present. -- to connect, and the file not being present.
Right <$> check Right <$> check
where where
check = untilTrue (rsyncUrls o k) $ \u -> check = untilTrue (rsyncUrls o k) $ \u ->
liftIO $ catchBoolIO $ do liftIO $ catchBoolIO $ do
withQuietOutput createProcessSuccess $ withQuietOutput createProcessSuccess $
proc "rsync" $ toCommand $ proc "rsync" $ toCommand $
@ -210,8 +210,8 @@ rsyncRemote o callback params = do
ps = rsyncOptions o ++ defaultParams ++ params ps = rsyncOptions o ++ defaultParams ++ params
{- To send a single key is slightly tricky; need to build up a temporary {- 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 - directory structure to pass to rsync so it can create the hash
directories. -} - directories. -}
rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> FilePath -> Annex Bool rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> FilePath -> Annex Bool
rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do
let dest = tmp </> Prelude.head (keyPaths k) let dest = tmp </> Prelude.head (keyPaths k)
@ -220,7 +220,7 @@ rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do
rsyncRemote o (Just callback) rsyncRemote o (Just callback)
[ Param "--recursive" [ Param "--recursive"
, partialParams , partialParams
-- tmp/ to send contents of tmp dir -- tmp/ to send contents of tmp dir
, Param $ addTrailingPathSeparator tmp , Param $ addTrailingPathSeparator tmp
, Param $ rsyncUrl o , Param $ rsyncUrl o
] ]

View file

@ -49,7 +49,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store this, storeKey = store this,
retrieveKeyFile = retrieve this, retrieveKeyFile = retrieve this,
retrieveKeyFileCheap = retrieveCheap this, retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this, removeKey = remove this,

View file

@ -55,7 +55,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost
uuid = u, uuid = u,
cost = cst, cost = cst,
name = Git.repoDescribe r, name = Git.repoDescribe r,
storeKey = store this, storeKey = store this,
retrieveKeyFile = retrieve this, retrieveKeyFile = retrieve this,
retrieveKeyFileCheap = retrieveCheap this, retrieveKeyFileCheap = retrieveCheap this,
removeKey = remove this, removeKey = remove this,
@ -314,10 +314,10 @@ getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u)
davCreds :: UUID -> CredPairStorage davCreds :: UUID -> CredPairStorage
davCreds u = CredPairStorage davCreds u = CredPairStorage
{ credPairFile = fromUUID u { credPairFile = fromUUID u
, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD") , credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")
, credPairRemoteKey = Just "davcreds" , credPairRemoteKey = Just "davcreds"
} }
setCredsEnv :: (String, String) -> IO () setCredsEnv :: (String, String) -> IO ()
setCredsEnv creds = setEnvCredPair creds $ davCreds undefined setCredsEnv creds = setEnvCredPair creds $ davCreds undefined

View file

@ -22,9 +22,9 @@ data CommandCheck = CommandCheck { idCheck :: Int, runCheck :: Annex () }
- a list of start stage actions. -} - a list of start stage actions. -}
type CommandSeek = [String] -> Annex [CommandStart] type CommandSeek = [String] -> Annex [CommandStart]
{- c. The start stage is run before anything is printed about the {- c. The start stage is run before anything is printed about the
- command, is passed some input, and can early abort it - command, is passed some input, and can early abort it
- if the input does not make sense. It should run quickly and - if the input does not make sense. It should run quickly and
- should not modify Annex state. -} - should not modify Annex state. -}
type CommandStart = Annex (Maybe CommandPerform) type CommandStart = Annex (Maybe CommandPerform)
{- d. The perform stage is run after a message is printed about the command {- 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. -} - being run, and it should be where the bulk of the work happens. -}

View file

@ -35,13 +35,12 @@ canWatch = True
canWatch = False canWatch = False
#endif #endif
/* With inotify, discrete events will be received when making multiple changes {- With inotify, discrete events will be received when making multiple changes
* to the same filename. For example, adding it, deleting it, and adding it - to the same filename. For example, adding it, deleting it, and adding it
* again will be three events. - again will be three events.
* -
* OTOH, with kqueue, often only one event is received, indicating the most - OTOH, with kqueue, often only one event is received, indicating the most
* recent state of the file. - recent state of the file. -}
*/
eventsCoalesce :: Bool eventsCoalesce :: Bool
#if WITH_INOTIFY #if WITH_INOTIFY
eventsCoalesce = False eventsCoalesce = False
@ -53,14 +52,13 @@ eventsCoalesce = undefined
#endif #endif
#endif #endif
/* With inotify, file closing is tracked to some extent, so an add event {- 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 - 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. - (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 - 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 - still being written to, and then no add event will be received once the
* writer closes it. - writer closes it. -}
*/
closingTracked :: Bool closingTracked :: Bool
#if WITH_INOTIFY #if WITH_INOTIFY
closingTracked = True closingTracked = True
@ -72,9 +70,8 @@ closingTracked = undefined
#endif #endif
#endif #endif
/* With inotify, modifications to existing files can be tracked. {- With inotify, modifications to existing files can be tracked.
* Kqueue does not support this. - Kqueue does not support this. -}
*/
modifyTracked :: Bool modifyTracked :: Bool
#if WITH_INOTIFY #if WITH_INOTIFY
modifyTracked = True modifyTracked = True
@ -86,11 +83,11 @@ modifyTracked = undefined
#endif #endif
#endif #endif
/* Starts a watcher thread. The runStartup action is passed a scanner action {- Starts a watcher thread. The runStartup action is passed a scanner action
* to run, that will return once the initial directory scan is complete. - to run, that will return once the initial directory scan is complete.
* Once runStartup returns, the watcher thread continues running, - Once runStartup returns, the watcher thread continues running,
* and processing events. Returns a DirWatcherHandle that can be used - and processing events. Returns a DirWatcherHandle that can be used
* to shutdown later. */ - to shutdown later. -}
#if WITH_INOTIFY #if WITH_INOTIFY
type DirWatcherHandle = INotify.INotify type DirWatcherHandle = INotify.INotify
watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle

View file

@ -16,7 +16,7 @@ import System.Posix.Env (setEnv, unsetEnv, getEnv)
import Common import Common
newtype KeyIds = KeyIds [String] newtype KeyIds = KeyIds [String]
deriving (Ord, Eq) deriving (Ord, Eq)
stdParams :: [CommandParam] -> IO [String] stdParams :: [CommandParam] -> IO [String]
stdParams params = do stdParams params = do

View file

@ -14,9 +14,9 @@ module Utility.JSONStream (
import Text.JSON import Text.JSON
{- Text.JSON does not support building up a larger JSON document piece by {- 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 - 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 - to a string with its final "}" is left off, allowing it to be added to
later. -} - later. -}
start :: JSON a => [(String, a)] -> String start :: JSON a => [(String, a)] -> String
start l start l
| last s == endchar = init s | last s == endchar = init s

View file

@ -22,7 +22,7 @@ import System.FilePath
viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO () viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
viaTmp a file content = do viaTmp a file content = do
pid <- getProcessID pid <- getProcessID
let tmpfile = file ++ ".tmp" ++ show pid let tmpfile = file ++ ".tmp" ++ show pid
createDirectoryIfMissing True (parentDir file) createDirectoryIfMissing True (parentDir file)
a tmpfile content a tmpfile content
renameFile tmpfile file renameFile tmpfile file