mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

hlint

Browse source
This commit is contained in:
Joey Hess 2013-10-02 00:42:27 -04:00
parent b24b5ca089
commit 028b0d8961
1 changed files with 13 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

17
Assistant/WebApp/Configurators/Local.hs
View file

@ -100,7 +100,7 @@ checkRepositoryPath p = do
Nothing -> Right $ Just $ T.pack basepath Nothing -> Right $ Just $ T.pack basepath
Just prob -> Left prob Just prob -> Left prob
where 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 home ('~':'/':path) = home </> path
expandTilde _ path = path expandTilde _ path = path
@ -113,7 +113,7 @@ checkRepositoryPath p = do
- browsed to a directory with git-annex and run it from there. -} - browsed to a directory with git-annex and run it from there. -}
defaultRepositoryPath :: Bool -> IO FilePath defaultRepositoryPath :: Bool -> IO FilePath
defaultRepositoryPath firstrun = do defaultRepositoryPath firstrun = do
cwd <- liftIO $ getCurrentDirectory cwd <- liftIO getCurrentDirectory
home <- myHomeDir home <- myHomeDir
if home == cwd && firstrun if home == cwd && firstrun
then inhome then inhome
@ -136,7 +136,7 @@ newRepositoryForm defpath msg = do
(Just $ T.pack $ addTrailingPathSeparator defpath) (Just $ T.pack $ addTrailingPathSeparator defpath)
let (err, errmsg) = case pathRes of let (err, errmsg) = case pathRes of
FormMissing -> (False, "") FormMissing -> (False, "")
FormFailure l -> (True, concat $ map T.unpack l) FormFailure l -> (True, concatMap T.unpack l)
FormSuccess _ -> (False, "") FormSuccess _ -> (False, "")
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken
@ -230,7 +230,7 @@ getAddDriveR :: Handler Html
getAddDriveR = postAddDriveR getAddDriveR = postAddDriveR
postAddDriveR :: Handler Html postAddDriveR :: Handler Html
postAddDriveR = page "Add a removable drive" (Just Configuration) $ do postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
removabledrives <- liftIO $ driveList removabledrives <- liftIO driveList
writabledrives <- liftIO $ writabledrives <- liftIO $
filterM (canWrite . T.unpack . mountPoint) removabledrives filterM (canWrite . T.unpack . mountPoint) removabledrives
((res, form), enctype) <- liftH $ runFormPost $ ((res, form), enctype) <- liftH $ runFormPost $
@ -276,7 +276,7 @@ setupDriveModal :: Widget
setupDriveModal = $(widgetFile "configurators/adddrive/setupmodal") setupDriveModal = $(widgetFile "configurators/adddrive/setupmodal")
getGenKeyForDriveR :: RemovableDrive -> Handler Html getGenKeyForDriveR :: RemovableDrive -> Handler Html
getGenKeyForDriveR drive = withNewSecretKey $ \keyid -> do getGenKeyForDriveR drive = withNewSecretKey $ \keyid ->
{- Generating a key takes a long time, and {- Generating a key takes a long time, and
- the removable drive may have been disconnected - the removable drive may have been disconnected
- in the meantime. Check that it is still mounted - in the meantime. Check that it is still mounted
@ -329,7 +329,7 @@ getFinishAddDriveR drive = go
- Next call syncRemote to get them in sync. -} - Next call syncRemote to get them in sync. -}
combineRepos :: FilePath -> String -> Handler Remote combineRepos :: FilePath -> String -> Handler Remote
combineRepos dir name = liftAnnex $ do combineRepos dir name = liftAnnex $ do
hostname <- maybe "host" id <$> liftIO getHostname hostname <- fromMaybe "host" <$> liftIO getHostname
hostlocation <- fromRepo Git.repoLocation hostlocation <- fromRepo Git.repoLocation
liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
addRemote $ makeGitRemote name dir addRemote $ makeGitRemote name dir
@ -380,7 +380,7 @@ startFullAssistant path repogroup setup = do
u <- initRepo isnew True path Nothing u <- initRepo isnew True path Nothing
inDir path $ do inDir path $ do
setStandardGroup u repogroup setStandardGroup u repogroup
maybe noop id setup fromMaybe noop setup
addAutoStartFile path addAutoStartFile path
setCurrentDirectory path setCurrentDirectory path
fromJust $ postFirstRun webapp fromJust $ postFirstRun webapp
@ -440,8 +440,7 @@ initRepo False _ dir desc = inDir dir $ do
getUUID getUUID
initRepo' :: Maybe String -> Annex () initRepo' :: Maybe String -> Annex ()
initRepo' desc = do initRepo' desc = unlessM isInitialized $ do
unlessM isInitialized $ do
initialize desc initialize desc
{- Ensure branch gets committed right away so it is {- Ensure branch gets committed right away so it is
- available for merging when a removable drive repo is being - available for merging when a removable drive repo is being