where indentation
This commit is contained in:
parent
b8009a68e4
commit
88d1907278
32 changed files with 720 additions and 732 deletions
|
@ -86,15 +86,15 @@ onAdd file
|
|||
|
||||
equivBranches :: Git.Ref -> Git.Ref -> Bool
|
||||
equivBranches x y = base x == base y
|
||||
where
|
||||
base = takeFileName . show
|
||||
where
|
||||
base = takeFileName . show
|
||||
|
||||
isAnnexBranch :: FilePath -> Bool
|
||||
isAnnexBranch f = n `isSuffixOf` f
|
||||
where
|
||||
n = "/" ++ show Annex.Branch.name
|
||||
where
|
||||
n = "/" ++ show Annex.Branch.name
|
||||
|
||||
fileToBranch :: FilePath -> Git.Ref
|
||||
fileToBranch f = Git.Ref $ "refs" </> base
|
||||
where
|
||||
base = Prelude.last $ split "/refs/" f
|
||||
where
|
||||
base = Prelude.last $ split "/refs/" f
|
||||
|
|
|
@ -119,36 +119,36 @@ startOneService client (x:xs) = do
|
|||
{- Filter matching events recieved when drives are mounted and unmounted. -}
|
||||
mountChanged :: [MatchRule]
|
||||
mountChanged = [gvfs True, gvfs False, kde, kdefallback]
|
||||
where
|
||||
{- gvfs reliably generates this event whenever a drive is mounted/unmounted,
|
||||
- whether automatically, or manually -}
|
||||
gvfs mount = matchAny
|
||||
{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
|
||||
, matchMember = Just $ if mount then "MountAdded" else "MountRemoved"
|
||||
}
|
||||
{- This event fires when KDE prompts the user what to do with a drive,
|
||||
- but maybe not at other times. And it's not received -}
|
||||
kde = matchAny
|
||||
{ matchInterface = Just "org.kde.Solid.Device"
|
||||
, matchMember = Just "setupDone"
|
||||
}
|
||||
{- This event may not be closely related to mounting a drive, but it's
|
||||
- observed reliably when a drive gets mounted or unmounted. -}
|
||||
kdefallback = matchAny
|
||||
{ matchInterface = Just "org.kde.KDirNotify"
|
||||
, matchMember = Just "enteredDirectory"
|
||||
}
|
||||
where
|
||||
{- gvfs reliably generates this event whenever a
|
||||
- drive is mounted/unmounted, whether automatically, or manually -}
|
||||
gvfs mount = matchAny
|
||||
{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
|
||||
, matchMember = Just $ if mount then "MountAdded" else "MountRemoved"
|
||||
}
|
||||
{- This event fires when KDE prompts the user what to do with a drive,
|
||||
- but maybe not at other times. And it's not received -}
|
||||
kde = matchAny
|
||||
{ matchInterface = Just "org.kde.Solid.Device"
|
||||
, matchMember = Just "setupDone"
|
||||
}
|
||||
{- This event may not be closely related to mounting a drive, but it's
|
||||
- observed reliably when a drive gets mounted or unmounted. -}
|
||||
kdefallback = matchAny
|
||||
{ matchInterface = Just "org.kde.KDirNotify"
|
||||
, matchMember = Just "enteredDirectory"
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
pollingThread :: Assistant ()
|
||||
pollingThread = go =<< liftIO currentMountPoints
|
||||
where
|
||||
go wasmounted = do
|
||||
liftIO $ threadDelaySeconds (Seconds 10)
|
||||
nowmounted <- liftIO currentMountPoints
|
||||
handleMounts wasmounted nowmounted
|
||||
go nowmounted
|
||||
where
|
||||
go wasmounted = do
|
||||
liftIO $ threadDelaySeconds (Seconds 10)
|
||||
nowmounted <- liftIO currentMountPoints
|
||||
handleMounts wasmounted nowmounted
|
||||
go nowmounted
|
||||
|
||||
handleMounts :: MountPoints -> MountPoints -> Assistant ()
|
||||
handleMounts wasmounted nowmounted =
|
||||
|
@ -179,11 +179,11 @@ remotesUnder dir = do
|
|||
liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = rs' }
|
||||
updateSyncRemotes
|
||||
return $ map snd $ filter fst pairs
|
||||
where
|
||||
checkremote repotop r = case Remote.localpath r of
|
||||
Just p | dirContains dir (absPathFrom repotop p) ->
|
||||
(,) <$> pure True <*> updateRemote r
|
||||
_ -> return (False, r)
|
||||
where
|
||||
checkremote repotop r = case Remote.localpath r of
|
||||
Just p | dirContains dir (absPathFrom repotop p) ->
|
||||
(,) <$> pure True <*> updateRemote r
|
||||
_ -> return (False, r)
|
||||
|
||||
type MountPoints = S.Set Mntent
|
||||
|
||||
|
|
|
@ -96,8 +96,8 @@ pairListenerThread urlrenderer = NamedThread "PairListener" $ do
|
|||
if n < chunksz
|
||||
then return $ c ++ msg
|
||||
else getmsg sock $ c ++ msg
|
||||
where
|
||||
chunksz = 1024
|
||||
where
|
||||
chunksz = 1024
|
||||
|
||||
{- Show an alert when a PairReq is seen. -}
|
||||
pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
|
||||
|
|
|
@ -34,8 +34,8 @@ pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
|
|||
void $ alertWhile (pushRetryAlert topush) $ do
|
||||
now <- liftIO $ getCurrentTime
|
||||
pushToRemotes now True topush
|
||||
where
|
||||
halfhour = 1800
|
||||
where
|
||||
halfhour = 1800
|
||||
|
||||
{- This thread pushes git commits out to remotes soon after they are made. -}
|
||||
pushThread :: NamedThread
|
||||
|
|
|
@ -76,10 +76,10 @@ onModify file = do
|
|||
case parseTransferFile file of
|
||||
Nothing -> noop
|
||||
Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
|
||||
where
|
||||
go _ Nothing = noop
|
||||
go t (Just newinfo) = alterTransferInfo t $
|
||||
\i -> i { bytesComplete = bytesComplete newinfo }
|
||||
where
|
||||
go _ Nothing = noop
|
||||
go t (Just newinfo) = alterTransferInfo t $
|
||||
\i -> i { bytesComplete = bytesComplete newinfo }
|
||||
|
||||
{- This thread can only watch transfer sizes when the DirWatcher supports
|
||||
- tracking modificatons to files. -}
|
||||
|
|
|
@ -104,5 +104,5 @@ shouldTransfer t info
|
|||
notElem (Remote.uuid remote)
|
||||
<$> loggedLocations key
|
||||
| otherwise = return False
|
||||
where
|
||||
key = transferKey t
|
||||
where
|
||||
key = transferKey t
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue