From eb46bdca48798d2b6ea3784018919351058cda84 Mon Sep 17 00:00:00 2001
From: Phil de Joux <philderbeast@gmail.com>
Date: Tue, 12 Dec 2023 14:52:42 -0500
Subject: [PATCH] Add symlink and install exe haddocks

As requested in review
---
 .../src/Distribution/Client/CmdInstall.hs         | 15 ++++++++++++---
 .../src/Distribution/Client/InstallSymlink.hs     | 10 +++++++++-
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
index 0917eb6b54b..5de704430f5 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -269,6 +269,9 @@ data InstallCfg = InstallCfg
   , installClientFlags :: ClientInstallFlags
   }
 
+-- | A record of install method, install directory and file path functions
+-- needed by actions that either check if an install is possible or actually
+-- perform an installation. This is for installation of executables only.
 data InstallExe = InstallExe
   { installMethod :: InstallMethod
   , installDir :: FilePath
@@ -638,10 +641,11 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt
     cliConfig = addLocalConfigToTargets baseCliConfig targetStrings
     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
 
+    -- Do the install action for each executable in the install configuration.
     traverseInstall :: InstallAction -> InstallCfg -> IO ()
     traverseInstall action cfg@InstallCfg{verbosity = v, buildCtx, installClientFlags} = do
       let overwritePolicy = fromFlagOrDefault NeverOverwrite $ cinstOverwritePolicy installClientFlags
-      actionOnExe <- action v overwritePolicy <$> installExesPrep cfg
+      actionOnExe <- action v overwritePolicy <$> prepareExeInstall cfg
       traverse_ actionOnExe . Map.toList $ targetsMap buildCtx
 
 -- | Treat all direct targets of install command as local packages: #8637
@@ -827,8 +831,11 @@ constructProjectBuildContext verbosity baseCtx targetSelectors = do
 
     return (prunedElaboratedPlan, targets)
 
-installExesPrep :: InstallCfg -> IO InstallExe
-installExesPrep
+-- | From an install configuration, prepare the record needed by actions that
+-- will either check if an install of a single executable is possible or
+-- actually perform its installation.
+prepareExeInstall :: InstallCfg -> IO InstallExe
+prepareExeInstall
   InstallCfg{verbosity, baseCtx, buildCtx, platform, compiler, installConfigFlags, installClientFlags} = do
     installPath <- defaultInstallPath
     let storeDirLayout = cabalStoreDirLayout $ cabalDirLayout baseCtx
@@ -997,6 +1004,8 @@ disableTestsBenchsByDefault configFlags =
     , configBenchmarks = Flag False <> configBenchmarks configFlags
     }
 
+-- | Prepares a record containing the information needed to either symlink or
+-- copy an executable.
 symlink :: OverwritePolicy -> InstallExe -> UnitId -> UnqualComponentName -> Symlink
 symlink
   overwritePolicy
diff --git a/cabal-install/src/Distribution/Client/InstallSymlink.hs b/cabal-install/src/Distribution/Client/InstallSymlink.hs
index 8025153531a..f453bc15d14 100644
--- a/cabal-install/src/Distribution/Client/InstallSymlink.hs
+++ b/cabal-install/src/Distribution/Client/InstallSymlink.hs
@@ -252,6 +252,8 @@ symlinkBinaries
       cinfo = compilerInfo comp
       (CompilerId compilerFlavor _) = compilerInfoId cinfo
 
+-- | A record needed to either check if a symlink is possible or to create a
+-- symlink. Also used if copying instead of symlinking.
 data Symlink = Symlink
   { overwritePolicy :: OverwritePolicy
   -- ^ Whether to force overwrite an existing file.
@@ -265,7 +267,12 @@ data Symlink = Symlink
   -- ^ The name of the executable to in the private bin dir, eg @foo-1.0@.
   }
 
--- | How to handle symlinking a binary.
+-- | After checking if a target is writeable given the overwrite policy,
+-- dispatch to an appropriate action;
+--  * @onMissing@ if the target doesn't exist
+--  * @onOverwrite@ if the target exists and we are allowed to overwrite it
+--  * @onNever@ if the target exists and we are never allowed to overwrite it
+--  * @onPrompt@ if the target exists and we are allowed to overwrite after prompting
 onSymlinkBinary
   :: IO a
   -- ^ Missing action
@@ -274,6 +281,7 @@ onSymlinkBinary
   -> IO a
   -- ^ Never action
   -> IO a
+  -- ^ Prompt action
   -> Symlink
   -> IO a
 onSymlinkBinary