whitespace fixes
This commit is contained in:
parent
f87a781aa6
commit
0d50a6105b
33 changed files with 97 additions and 100 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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!"
|
||||
)
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
6
Init.hs
6
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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
]
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue