From 155783d004f3512ffd87209c68b092fef02f8570 Mon Sep 17 00:00:00 2001
From: Mike Pilgrem <mpilgrem@users.noreply.github.com>
Date: Sat, 28 Oct 2023 12:49:42 +0100
Subject: [PATCH] Fix #6323 Fix splitComponents; make a helper function of
 NamedComponent

---
 src/Stack/Build/Source.hs         | 20 ++++++------------
 src/Stack/Types/NamedComponent.hs | 34 ++++++++++++++++++++++++++++++-
 2 files changed, 39 insertions(+), 15 deletions(-)

diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 470ace9cbe..4dd1e45646 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -49,7 +49,7 @@ import           Stack.Types.EnvConfig
                    )
 import           Stack.Types.FileDigestCache ( readFileDigest )
 import           Stack.Types.NamedComponent
-                   ( NamedComponent (..), isCSubLib )
+                   ( NamedComponent (..), isCSubLib, splitComponents )
 import           Stack.Types.Package
                    ( FileCacheInfo (..), LocalPackage (..), Package (..)
                    , PackageConfig (..), PackageLibraries (..)
@@ -273,18 +273,6 @@ generalGhcOptions bconfig boptsCli isTarget isLocal = concat
       AGOLocals -> isLocal
       AGOEverything -> True
 
-splitComponents :: [NamedComponent]
-                -> (Set Text, Set Text, Set Text)
-splitComponents =
-  go id id id
- where
-  go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c [])
-  go a b c (CLib:xs) = go a b c xs
-  go a b c (CSubLib x:xs) = go (a . (x:)) b c xs
-  go a b c (CExe x:xs) = go (a . (x:)) b c xs
-  go a b c (CTest x:xs) = go a (b . (x:)) c xs
-  go a b c (CBench x:xs) = go a b (c . (x:)) xs
-
 loadCommonPackage ::
      forall env. (HasBuildConfig env, HasSourceMap env)
   => CommonPackage
@@ -318,7 +306,11 @@ loadLocalPackage pp = do
       mtarget = M.lookup name (smtTargets $ smTargets sm)
       (exeCandidates, testCandidates, benchCandidates) =
         case mtarget of
-          Just (TargetComps comps) -> splitComponents $ Set.toList comps
+          Just (TargetComps comps) ->
+            -- Currently, a named library component (a sub-library) cannot be
+            -- specified as a build target.
+            let (_s, e, t, b) = splitComponents $ Set.toList comps
+            in  (e, t, b)
           Just (TargetAll _packageType) ->
             ( packageExes pkg
             , if    boptsTests bopts
diff --git a/src/Stack/Types/NamedComponent.hs b/src/Stack/Types/NamedComponent.hs
index d10647ee5f..cf21defc66 100644
--- a/src/Stack/Types/NamedComponent.hs
+++ b/src/Stack/Types/NamedComponent.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | Module exporting the 'NamedComponent' type and related functions.
 module Stack.Types.NamedComponent
   ( NamedComponent (..)
   , renderComponent
@@ -15,19 +16,25 @@ module Stack.Types.NamedComponent
   , isCExe
   , isCTest
   , isCBench
+  , splitComponents
   ) where
 
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Stack.Prelude
 
--- | A single, fully resolved component of a package
+-- | Type representing components of a fully-resolved Cabal package.
 data NamedComponent
   = CLib
+    -- The \'main\' unnamed library component.
   | CSubLib !Text
+    -- A named \'subsidiary\' or \'ancillary\` library component (sub-library).
   | CExe !Text
+    -- A named executable component.
   | CTest !Text
+    -- A named test-suite component.
   | CBench !Text
+    -- A named benchmark component.
   deriving (Eq, Ord, Show)
 
 renderComponent :: NamedComponent -> Text
@@ -87,3 +94,28 @@ isCTest _ = False
 isCBench :: NamedComponent -> Bool
 isCBench CBench{} = True
 isCBench _ = False
+
+-- | A function to split the given list of components into sets of the names of
+-- the named components by the type of component (sub-libraries, executables,
+-- test-suites, benchmarks), ignoring any 'main' unnamed library component.
+splitComponents ::
+     [NamedComponent]
+  -> ( Set Text
+       -- ^ Sub-libraries.
+     , Set Text
+       -- ^ Executables.
+     , Set Text
+       -- ^ Test-suites.
+     , Set Text
+       -- ^ Benchmarks.
+     )
+splitComponents =
+  go id id id id
+ where
+  run c = Set.fromList $ c []
+  go s e t b [] = (run s, run e, run t, run b)
+  go s e t b (CLib:xs) = go s e t b xs
+  go s e t b (CSubLib x:xs) = go (s . (x:)) e t b xs
+  go s e t b (CExe x:xs) = go s (e . (x:)) t b xs
+  go s e t b (CTest x:xs) = go s e (t . (x:)) b xs
+  go s e t b (CBench x:xs) = go s e t (b . (x:)) xs