From ad6b49c683edac148a773e231e86797dfb9f9534 Mon Sep 17 00:00:00 2001 From: Phil de Joux <philderbeast@gmail.com> Date: Sun, 17 Sep 2023 09:53:37 -0400 Subject: [PATCH] Satisfy fourmolu with make style --- .../src/Distribution/Client/CmdInstall.hs | 60 +++++++------- .../src/Distribution/Client/InstallSymlink.hs | 82 ++++++++++--------- 2 files changed, 75 insertions(+), 67 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 10d548f75d6..6338d78fb70 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -53,7 +53,7 @@ import Distribution.Client.IndexUtils ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallSymlink - ( Symlink(..) + ( Symlink (..) , promptRun , symlinkBinary , symlinkableBinary @@ -568,15 +568,17 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt || buildSettingOnlyDownload (buildSettings baseCtx) -- Before building, check if we can do the install. - unless (dryRun || installLibs) - (installableExes - verbosity - baseCtx - buildCtx - platform - compiler - configFlags - clientInstallFlags) + unless + (dryRun || installLibs) + ( installableExes + verbosity + baseCtx + buildCtx + platform + compiler + configFlags + clientInstallFlags + ) buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes @@ -807,18 +809,17 @@ constructProjectBuildContext verbosity baseCtx targetSelectors = do return (prunedElaboratedPlan, targets) -data InstallExe = - InstallExe - { installMethod :: InstallMethod - , installDir :: FilePath - , mkSourceBinDir :: UnitId -> FilePath - -- ^ A function to get an UnitId's store directory. - , mkExeName :: UnqualComponentName -> FilePath - -- ^ A function to get an exe's filename. - , mkFinalExeName :: UnqualComponentName -> FilePath - -- ^ A function to get an exe's final possibly different to the name in the - -- store. - } +data InstallExe = InstallExe + { installMethod :: InstallMethod + , installDir :: FilePath + , mkSourceBinDir :: UnitId -> FilePath + -- ^ A function to get an UnitId's store directory. + , mkExeName :: UnqualComponentName -> FilePath + -- ^ A function to get an exe's filename. + , mkFinalExeName :: UnqualComponentName -> FilePath + -- ^ A function to get an exe's final possibly different to the name in the + -- store. + } installExesPrep :: Verbosity @@ -962,7 +963,7 @@ defaultMethod verbosity return $ if symlinks then InstallMethodSymlink else InstallMethodCopy | otherwise = return InstallMethodSymlink where - isWindows = buildOS == Windows + isWindows = buildOS == Windows -- | Install any built library by adding it to the default ghc environment installLibraries @@ -1204,12 +1205,13 @@ installBuiltExe InstallMethodSymlink = do notice verbosity $ "Symlinking '" <> exeName <> "' to '" <> destination <> "'" symlinkBinary - (Symlink - overwritePolicy - installdir - sourceDir - finalExeName - exeName) + ( Symlink + overwritePolicy + installdir + sourceDir + finalExeName + exeName + ) where destination = installdir </> finalExeName installBuiltExe diff --git a/cabal-install/src/Distribution/Client/InstallSymlink.hs b/cabal-install/src/Distribution/Client/InstallSymlink.hs index 7fdc7b111fe..8025153531a 100644 --- a/cabal-install/src/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/src/Distribution/Client/InstallSymlink.hs @@ -17,7 +17,7 @@ -- -- Managing installing binaries with symlinks. module Distribution.Client.InstallSymlink - ( Symlink(..) + ( Symlink (..) , symlinkBinaries , symlinkBinary , symlinkableBinary @@ -153,12 +153,13 @@ symlinkBinaries privateBinDir <- pkgBinDir pkg ipid ok <- symlinkBinary - (Symlink - overwritePolicy - publicBinDir - privateBinDir - (prettyShow publicExeName) - privateExeName) + ( Symlink + overwritePolicy + publicBinDir + privateBinDir + (prettyShow publicExeName) + privateExeName + ) if ok then return Nothing else @@ -251,43 +252,48 @@ symlinkBinaries cinfo = compilerInfo comp (CompilerId compilerFlavor _) = compilerInfoId cinfo -data Symlink = - Symlink - { overwritePolicy :: OverwritePolicy - -- ^ Whether to force overwrite an existing file. - , publicBindir :: FilePath - -- ^ The canonical path of the public bin dir eg @/home/user/bin@. - , privateBindir :: FilePath - -- ^ The canonical path of the private bin dir eg @/home/user/.cabal/bin@. - , publicName :: FilePath - -- ^ The name of the executable to go in the public bin dir, eg @foo@. - , privateName :: String - -- ^ The name of the executable to in the private bin dir, eg @foo-1.0@. - } +data Symlink = Symlink + { overwritePolicy :: OverwritePolicy + -- ^ Whether to force overwrite an existing file. + , publicBindir :: FilePath + -- ^ The canonical path of the public bin dir eg @/home/user/bin@. + , privateBindir :: FilePath + -- ^ The canonical path of the private bin dir eg @/home/user/.cabal/bin@. + , publicName :: FilePath + -- ^ The name of the executable to go in the public bin dir, eg @foo@. + , privateName :: String + -- ^ The name of the executable to in the private bin dir, eg @foo-1.0@. + } -- | How to handle symlinking a binary. onSymlinkBinary - :: IO a -- ^ Missing action - -> IO a -- ^ Overwrite action - -> IO a -- ^ Never action + :: IO a + -- ^ Missing action + -> IO a + -- ^ Overwrite action + -> IO a + -- ^ Never action -> IO a -> Symlink -> IO a onSymlinkBinary - onMissing onOverwrite onNever onPrompt - Symlink{ overwritePolicy, publicBindir, privateBindir, publicName, privateName } = do - ok <- - targetOkToOverwrite - (publicBindir </> publicName) - (privateBindir </> privateName) - case ok of - NotExists -> onMissing - OkToOverwrite -> onOverwrite - NotOurFile -> - case overwritePolicy of - NeverOverwrite -> onNever - AlwaysOverwrite -> onOverwrite - PromptOverwrite -> onPrompt + onMissing + onOverwrite + onNever + onPrompt + Symlink{overwritePolicy, publicBindir, privateBindir, publicName, privateName} = do + ok <- + targetOkToOverwrite + (publicBindir </> publicName) + (privateBindir </> privateName) + case ok of + NotExists -> onMissing + OkToOverwrite -> onOverwrite + NotOurFile -> + case overwritePolicy of + NeverOverwrite -> onNever + AlwaysOverwrite -> onOverwrite + PromptOverwrite -> onPrompt -- | Can we symlink a binary? -- @@ -303,7 +309,7 @@ symlinkableBinary = onSymlinkBinary (return True) (return True) (return False) ( -- file there already that we did not own. Other errors like permission errors -- just propagate as exceptions. symlinkBinary :: Symlink -> IO Bool -symlinkBinary inputs@Symlink{publicBindir, privateBindir, publicName, privateName } = do +symlinkBinary inputs@Symlink{publicBindir, privateBindir, publicName, privateName} = do onSymlinkBinary mkLink overwrite (return False) maybeOverwrite inputs where relativeBindir = makeRelative publicBindir privateBindir