where indentation
This commit is contained in:
parent
b8009a68e4
commit
88d1907278
32 changed files with 720 additions and 732 deletions
|
@ -50,8 +50,7 @@ handleDrops' locs rs fromhere key (Just f)
|
|||
| checkcopies n = dropr r n >>= go rest
|
||||
| otherwise = noop
|
||||
|
||||
checkdrop n@(_, numcopies) u a =
|
||||
ifM (wantDrop u (Just f))
|
||||
checkdrop n@(_, numcopies) u a = ifM (wantDrop u (Just f))
|
||||
( ifM (doCommand $ a (Just numcopies))
|
||||
( return $ decrcopies n
|
||||
, return n
|
||||
|
|
|
@ -47,8 +47,7 @@ ensureInstalled = go =<< standaloneAppBase
|
|||
#ifdef darwin_HOST_OS
|
||||
autostartfile <- userAutoStart osxAutoStartLabel
|
||||
#else
|
||||
autostartfile <- autoStartPath "git-annex"
|
||||
<$> userConfigDir
|
||||
autostartfile <- autoStartPath "git-annex" <$> userConfigDir
|
||||
#endif
|
||||
installAutoStart program autostartfile
|
||||
|
||||
|
|
|
@ -120,8 +120,8 @@ startOneService client (x:xs) = do
|
|||
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 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"
|
||||
|
|
|
@ -84,14 +84,10 @@ checkRepositoryPath p = do
|
|||
Nothing -> Right $ Just $ T.pack basepath
|
||||
Just prob -> Left prob
|
||||
where
|
||||
runcheck (chk, msg) = ifM (chk)
|
||||
( return $ Just msg
|
||||
, return Nothing
|
||||
)
|
||||
runcheck (chk, msg) = ifM (chk) ( return $ Just msg, return Nothing )
|
||||
expandTilde home ('~':'/':path) = home </> path
|
||||
expandTilde _ path = path
|
||||
|
||||
|
||||
{- On first run, if run in the home directory, default to putting it in
|
||||
- ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise.
|
||||
-
|
||||
|
@ -216,8 +212,7 @@ getAddDriveR = bootstrap (Just Config) $ do
|
|||
addremote dir name = runAnnex undefined $ do
|
||||
hostname <- maybe "host" id <$> liftIO getHostname
|
||||
hostlocation <- fromRepo Git.repoLocation
|
||||
liftIO $ inDir dir $
|
||||
void $ makeGitRemote hostname hostlocation
|
||||
liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
|
||||
addRemote $ makeGitRemote name dir
|
||||
|
||||
getEnableDirectoryR :: UUID -> Handler RepHtml
|
||||
|
|
|
@ -144,8 +144,7 @@ getEnableRsyncR u = do
|
|||
T.pack . concat <$> prettyListUUIDs [u]
|
||||
let authtoken = webAppFormAuthToken
|
||||
$(widgetFile "configurators/ssh/enable")
|
||||
enable sshdata =
|
||||
lift $ redirect $ ConfirmSshR $
|
||||
enable sshdata = lift $ redirect $ ConfirmSshR $
|
||||
sshdata { rsyncOnly = True }
|
||||
|
||||
{- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync
|
||||
|
@ -178,7 +177,7 @@ parseSshRsyncUrl u
|
|||
- a special ssh key will need to be generated just for this server.
|
||||
-
|
||||
- Once logged into the server, probe to see if git-annex-shell is
|
||||
- available, or rsync. Note that on OSX, ~/.ssh/git-annex-shell may be
|
||||
- available, or rsync. Note that, ~/.ssh/git-annex-shell may be
|
||||
- present, while git-annex-shell is not in PATH.
|
||||
-}
|
||||
testServer :: SshInput -> IO (Either ServerStatus SshData)
|
||||
|
@ -194,8 +193,7 @@ testServer sshinput@(SshInput { hostname = Just hn }) = do
|
|||
then ret status' True
|
||||
else return $ Left status'
|
||||
where
|
||||
ret status needspubkey = return $ Right $
|
||||
(mkSshData sshinput)
|
||||
ret status needspubkey = return $ Right $ (mkSshData sshinput)
|
||||
{ needsPubKey = needspubkey
|
||||
, rsyncOnly = status == UsableRsyncServer
|
||||
}
|
||||
|
@ -204,7 +202,7 @@ testServer sshinput@(SshInput { hostname = Just hn }) = do
|
|||
[ report "loggedin"
|
||||
, checkcommand "git-annex-shell"
|
||||
, checkcommand "rsync"
|
||||
, checkcommand osx_shim
|
||||
, checkcommand shim
|
||||
]
|
||||
knownhost <- knownHost hn
|
||||
let sshopts = filter (not . null) $ extraopts ++
|
||||
|
@ -219,7 +217,7 @@ testServer sshinput@(SshInput { hostname = Just hn }) = do
|
|||
parsetranscript . fst <$> sshTranscript sshopts ""
|
||||
parsetranscript s
|
||||
| reported "git-annex-shell" = UsableSshInput
|
||||
| reported osx_shim = UsableSshInput
|
||||
| reported shim = UsableSshInput
|
||||
| reported "rsync" = UsableRsyncServer
|
||||
| reported "loggedin" = UnusableServer
|
||||
"Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?"
|
||||
|
@ -230,7 +228,7 @@ testServer sshinput@(SshInput { hostname = Just hn }) = do
|
|||
checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
|
||||
token r = "git-annex-probe " ++ r
|
||||
report r = "echo " ++ token r
|
||||
osx_shim = "~/.ssh/git-annex-shell"
|
||||
shim = "~/.ssh/git-annex-shell"
|
||||
|
||||
{- Runs a ssh command; if it fails shows the user the transcript,
|
||||
- and if it succeeds, runs an action. -}
|
||||
|
|
|
@ -33,8 +33,7 @@ getSwitchToRepositoryR repo = do
|
|||
startassistant = do
|
||||
program <- readProgramFile
|
||||
void $ forkIO $ void $ createProcess $
|
||||
(proc program ["assistant"])
|
||||
{ cwd = Just repo }
|
||||
(proc program ["assistant"]) { cwd = Just repo }
|
||||
geturl = do
|
||||
r <- Git.Config.read =<< Git.Construct.fromPath repo
|
||||
waiturl $ gitAnnexUrlFile r
|
||||
|
@ -46,8 +45,7 @@ getSwitchToRepositoryR repo = do
|
|||
( return url
|
||||
, delayed $ waiturl urlfile
|
||||
)
|
||||
listening url = catchBoolIO $
|
||||
fst <$> Url.exists url []
|
||||
listening url = catchBoolIO $ fst <$> Url.exists url []
|
||||
delayed a = do
|
||||
threadDelay 100000 -- 1/10th of a second
|
||||
a
|
||||
|
|
|
@ -87,8 +87,7 @@ cancelTransfer pause t = do
|
|||
| pause = throwTo tid PauseTransfer
|
||||
| otherwise = killThread tid
|
||||
{- In order to stop helper processes like rsync,
|
||||
- kill the whole process group of the process running the
|
||||
- transfer. -}
|
||||
- kill the whole process group of the process running the transfer. -}
|
||||
killproc pid = do
|
||||
g <- getProcessGroupIDOf pid
|
||||
void $ tryIO $ signalProcessGroup sigTERM g
|
||||
|
|
Loading…
Reference in a new issue