Adds the sanity check function for isolated installs
This commit is contained in:
parent
80fa7965a4
commit
bb430fa0b7
22
lib/GHCup.hs
22
lib/GHCup.hs
@ -2251,6 +2251,28 @@ upgradeGHCup mtarget force' = do
|
|||||||
--[ Other ]--
|
--[ Other ]--
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
|
-- | Does basic checks for isolated installs
|
||||||
|
-- Isolated Directory:
|
||||||
|
-- 1. if it doesn't exist -> proceed
|
||||||
|
-- 2. if it exists and is empty -> proceed
|
||||||
|
-- 3. if it exists and is non-empty -> panic and leave the house
|
||||||
|
|
||||||
|
isolatedInstallSanityCheck :: ( MonadIO m
|
||||||
|
, MonadThrow m
|
||||||
|
) =>
|
||||||
|
FilePath ->
|
||||||
|
Excepts '[IsolatedDirNotEmpty] m ()
|
||||||
|
isolatedInstallSanityCheck isoDir = do
|
||||||
|
dirExists <- liftIO $ doesDirectoryExist isoDir
|
||||||
|
if not dirExists
|
||||||
|
then pure ()
|
||||||
|
else do
|
||||||
|
len <- liftIO $ length <$> listDirectory isoDir
|
||||||
|
let isDirEmpty = len == 0
|
||||||
|
if isDirEmpty
|
||||||
|
then pure ()
|
||||||
|
else (throwE $ IsolatedDirNotEmpty isoDir)
|
||||||
|
|
||||||
|
|
||||||
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
|
-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
|
||||||
-- both installing from source and bindist.
|
-- both installing from source and bindist.
|
||||||
|
Loading…
Reference in New Issue
Block a user