windows disk free space checking

This commit is contained in:
Joey Hess 2013-12-10 01:18:04 -04:00
parent 8699a36438
commit 063a183a61
4 changed files with 22 additions and 12 deletions

View file

@ -351,20 +351,11 @@ driveList :: IO [RemovableDrive]
#ifdef mingw32_HOST_OS
-- Just enumerate all likely drive letters for Windows.
-- Could use wmic, but it only works for administrators.
driveList = return $ map (\l -> gen $ l:":\\") ['A'..'Z']
where
gen dir = RemovableDrive
Nothing
(T.pack dir)
(T.pack gitAnnexAssistantDefaultDir)
driveList = mapM (\d -> genRemovableDrive $ d:":\\") ['A'..'Z']
#else
#ifdef WITH_CLIBS
driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts
driveList = mapM (genRemovableDrive . mnt_dir) =<< filter sane <$> getMounts
where
gen dir = RemovableDrive
<$> getDiskFree dir
<*> pure (T.pack dir)
<*> pure (T.pack gitAnnexAssistantDefaultDir)
-- filter out some things that are surely not removable drives
sane Mntent { mnt_dir = dir, mnt_fsname = dev }
{- We want real disks like /dev/foo, not
@ -387,6 +378,12 @@ driveList = return []
#endif
#endif
genRemovableDrive :: FilePath -> IO RemovableDrive
genRemovableDrive dir = RemovableDrive
<$> getDiskFree dir
<*> pure (T.pack dir)
<*> pure (T.pack gitAnnexAssistantDefaultDir)
{- Bootstraps from first run mode to a fully running assistant in a
- repository, by running the postFirstRun callback, which returns the
- url to the new webapp. -}