refactoring: generalize systematic use of StackUnqualCompName

Author: theobat

src/Path/CheckInstall.hs

@@ -6,7 +6,6 @@ module Path.CheckInstall
   ) where
 
 import           Control.Monad.Extra ( (&&^), anyM )
-import qualified Data.Text as T
 import           Stack.Prelude
 import           Stack.Types.Config ( HasConfig )
 import qualified System.Directory as D
@@ -15,7 +14,7 @@ import qualified System.FilePath as FP
 -- | Checks if the installed executable will be available on the user's PATH.
 -- This doesn't use @envSearchPath menv@ because it includes paths only visible
 -- when running in the Stack environment.
-warnInstallSearchPathIssues :: HasConfig env => FilePath -> [Text] -> RIO env ()
+warnInstallSearchPathIssues :: HasConfig env => FilePath -> [String] -> RIO env ()
 warnInstallSearchPathIssues destDir installed = do
   searchPath <- liftIO FP.getSearchPath
   destDirIsInPATH <- liftIO $
@@ -26,28 +25,28 @@ warnInstallSearchPathIssues destDir installed = do
       searchPath
   if destDirIsInPATH
     then forM_ installed $ \exe -> do
-      mexePath <- (liftIO . D.findExecutable . T.unpack) exe
+      mexePath <- (liftIO . D.findExecutable) exe
       case mexePath of
         Just exePath -> do
           exeDir <-
             (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
           unless (exeDir `FP.equalFilePath` destDir) $
             prettyWarnL
               [ flow "The"
-              , style File . fromString . T.unpack $ exe
+              , style File . fromString $ exe
               , flow "executable found on the PATH environment variable is"
               , style File . fromString $ exePath
               , flow "and not the version that was just installed."
               , flow "This means that"
-              , style File . fromString . T.unpack $ exe
+              , style File . fromString $ exe
               , "calls on the command line will not use this version."
               ]
         Nothing ->
           prettyWarnL
             [ flow "Installation path"
             , style Dir . fromString $ destDir
             , flow "is on the PATH but the"
-            , style File . fromString . T.unpack $ exe
+            , style File . fromString $ exe
             , flow "executable that was just installed could not be found on \
                    \the PATH."
             ]

src/Stack/Build.hs

@@ -20,7 +20,6 @@ import           Data.List ( (\\) )
 import           Data.List.Extra ( groupSort )
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.Text as T
 -- import qualified Distribution.PackageDescription as C
 -- import           Distribution.Types.Dependency ( Dependency (..), depLibraries )
 import           Distribution.Version ( mkVersion )
@@ -52,6 +51,7 @@ import           Stack.Types.BuildOptsMonoid
                    )
 import           Stack.Types.Compiler ( getGhcVersion )
 import           Stack.Types.CompilerPaths ( HasCompiler, cabalVersionL )
+import           Stack.Types.ComponentUtils ( StackUnqualCompName, unqualCompToString )
 import           Stack.Types.Config
                    ( Config (..), HasConfig (..), buildOptsL
                    )
@@ -266,7 +266,7 @@ warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = do
             ","
             [ style
                 PkgComponent
-                (fromString $ packageNameString p <> ":" <> T.unpack exe)
+                (fromString $ packageNameString p <> ":" <> unqualCompToString exe)
             | p <- pkgs
             ]
     prettyWarnL $
@@ -295,7 +295,7 @@ warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = do
   --                   , package names for other project packages that have an
   --                     executable with the same name
   --                   )
-  warnings :: Map Text ([PackageName],[PackageName])
+  warnings :: Map StackUnqualCompName ([PackageName],[PackageName])
   warnings =
     Map.mapMaybe
       (\(pkgsToBuild, localPkgs) ->
@@ -315,15 +315,15 @@ warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = do
             -- Both cases warrant a warning.
             Just (NE.toList pkgsToBuild, otherLocals))
       (Map.intersectionWith (,) exesToBuild localExes)
-  exesToBuild :: Map Text (NonEmpty PackageName)
+  exesToBuild :: Map StackUnqualCompName (NonEmpty PackageName)
   exesToBuild =
     collect
       [ (exe, pkgName')
       | (pkgName', task) <- Map.toList plan.tasks
       , TTLocalMutable lp <- [task.taskType]
       , exe <- (Set.toList . exeComponents . (.components)) lp
       ]
-  localExes :: Map Text (NonEmpty PackageName)
+  localExes :: Map StackUnqualCompName (NonEmpty PackageName)
   localExes =
     collect
       [ (exe, pkg.name)

src/Stack/Build/Cache.hs

@@ -63,6 +63,7 @@ import           Stack.Types.Build
                    )
 import           Stack.Types.Cache ( ConfigCacheType (..) )
 import           Stack.Types.CompilerPaths ( cabalVersionL )
+import           Stack.Types.ComponentUtils ( StackUnqualCompName, unqualCompToString )
 import           Stack.Types.Config ( stackRootL )
 import           Stack.Types.ConfigureOpts
                    ( BaseConfigOpts (..), ConfigureOpts (..) )
@@ -134,7 +135,6 @@ buildCacheFile dir component = do
   cachesDir <- buildCachesDir dir
   smh <- view $ envConfigL . to (.sourceMapHash)
   smDirName <- smRelDir smh
-  let nonLibComponent prefix name = prefix <> "-" <> T.unpack name
   cacheFileName <- parseRelFile $ componentCachePath component
   pure $ cachesDir </> smDirName </> cacheFileName
 
@@ -370,7 +370,7 @@ writePrecompiledCache ::
   -> ConfigureOpts
   -> Bool -- ^ build haddocks
   -> Installed -- ^ library
-  -> Set Text -- ^ executables
+  -> Set StackUnqualCompName -- ^ executables
   -> RIO env ()
 writePrecompiledCache
     baseConfigOpts
@@ -384,7 +384,7 @@ writePrecompiledCache
       ec <- view envConfigL
       let stackRootRelative = makeRelative (view stackRootL ec)
       exes' <- forM (Set.toList exes) $ \exe -> do
-        name <- parseRelFile $ T.unpack exe
+        name <- parseRelFile $ unqualCompToString exe
         stackRootRelative $
            baseConfigOpts.snapInstallRoot </> bindirSuffix </> name
       let installedLibToPath libName ghcPkgId pcAction = do

src/Stack/Build/Execute.hs

@@ -64,6 +64,7 @@ import           Stack.Types.BuildOptsCLI ( BuildOptsCLI (..) )
 import           Stack.Types.BuildOptsMonoid ( ProgressBarFormat (..) )
 import           Stack.Types.Compiler ( ActualCompiler (..) )
 import           Stack.Types.CompilerPaths ( HasCompiler (..), getGhcPkgExe )
+import           Stack.Types.ComponentUtils ( StackUnqualCompName, unqualCompToString )
 import           Stack.Types.Config
                    ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.ConfigureOpts
@@ -162,7 +163,7 @@ printPlan plan = do
             <> line
     xs -> do
       let executableMsg (name, loc) = fillSep $
-              fromString (T.unpack name)
+              fromString (unqualCompToString name)
             : "from"
             : ( case loc of
                   Snap -> "snapshot" :: StyleDoc
@@ -260,7 +261,7 @@ executePlan
 
 copyExecutables ::
        HasEnvConfig env
-    => Map Text InstallLocation
+    => Map StackUnqualCompName InstallLocation
     -> RIO env ()
 copyExecutables exes | Map.null exes = pure ()
 copyExecutables exes = do
@@ -283,23 +284,24 @@ copyExecutables exes = do
   currExe <- liftIO getExecutablePath -- needed for windows, see below
 
   installed <- forMaybeM (Map.toList exes) $ \(name, loc) -> do
+    let strName = unqualCompToString name
     let bindir =
             case loc of
                 Snap -> snapBin
                 Local -> localBin
-    mfp <- forgivingResolveFile bindir (T.unpack name ++ ext)
+    mfp <- forgivingResolveFile bindir (strName ++ ext)
       >>= rejectMissingFile
     case mfp of
       Nothing -> do
         prettyWarnL
           [ flow "Couldn't find executable"
-          , style Current (fromString $ T.unpack name)
+          , style Current (fromString strName)
           , flow "in directory"
           , pretty bindir <> "."
           ]
         pure Nothing
       Just file -> do
-        let destFile = destDir' FP.</> T.unpack name ++ ext
+        let destFile = destDir' FP.</> strName ++ ext
         prettyInfoL
           [ flow "Copying from"
           , pretty file
@@ -311,7 +313,7 @@ copyExecutables exes = do
           Platform _ Windows | FP.equalFilePath destFile currExe ->
               windowsRenameCopy (toFilePath file) destFile
           _ -> D.copyFile (toFilePath file) destFile
-        pure $ Just (name <> T.pack ext)
+        pure $ Just (strName ++ ext)
 
   unless (null installed) $ do
     prettyInfo $
@@ -321,7 +323,7 @@ copyExecutables exes = do
            ]
       <> line
       <> bulletedList
-           (map (fromString . T.unpack . textDisplay) installed :: [StyleDoc])
+           (map fromString installed :: [StyleDoc])
   unless compilerSpecific $ warnInstallSearchPathIssues destDir' installed
 
 -- | Windows can't write over the current executable. Instead, we rename the

src/Stack/Build/ExecutePackage.hs

@@ -32,8 +32,6 @@ import           Distribution.System ( OS (..), Platform (..) )
 import qualified Distribution.Text as C
 import           Distribution.Types.MungedPackageName
                    ( encodeCompatPackageName )
-import           Distribution.Types.UnqualComponentName
-                   ( mkUnqualComponentName )
 import           Distribution.Version ( mkVersion )
 import           Path
                    ( (</>), addExtension, filename, isProperPrefixOf, parent
@@ -849,9 +847,9 @@ copyPreCompiled ee task pkgId (PrecompiledCache mlib subLibs exes) = do
     subLibNames = Set.toList $ buildableSubLibs $ case task.taskType of
       TTLocalMutable lp -> lp.package
       TTRemotePackage _ p _ -> p
-    toMungedPackageId :: Text -> MungedPackageId
+    toMungedPackageId :: StackUnqualCompName -> MungedPackageId
     toMungedPackageId subLib =
-      let subLibName = LSubLibName $ mkUnqualComponentName $ T.unpack subLib
+      let subLibName = LSubLibName $ toCabalName subLib
       in  MungedPackageId (MungedPackageName pname subLibName) pversion
     toPackageId :: MungedPackageId -> PackageIdentifier
     toPackageId (MungedPackageId n v) =
@@ -1247,7 +1245,7 @@ singleTest topts testsToRun ac ee task installedMap = do
 -- | Implements running a package's benchmarks.
 singleBench :: HasEnvConfig env
             => BenchmarkOpts
-            -> [Text]
+            -> [StackUnqualCompName]
             -> ActionContext
             -> ExecuteEnv
             -> Task
@@ -1257,7 +1255,7 @@ singleBench beopts benchesToRun ac ee task installedMap = do
   (allDepsMap, _cache) <- getConfigCache ee task installedMap False True
   withSingleContext ac ee task.taskType allDepsMap (Just "bench") $
     \_package _cabalfp _pkgDir cabal announce _outputType -> do
-      let args = map T.unpack benchesToRun <> maybe []
+      let args = map unqualCompToString benchesToRun <> maybe []
                        ((:[]) . ("--benchmark-options=" <>))
                        beopts.additionalArgs
 
@@ -1307,15 +1305,13 @@ primaryComponentOptions lp =
   ++ map
        (T.unpack . T.append "lib:")
        (getBuildableListText package.subLibraries)
-  ++ map
-       (T.unpack . T.append "exe:")
-       (Set.toList $ exesToBuild lp)
+  ++ Set.toList (Set.mapMonotonic (\s -> "exe:" ++ unqualCompToString s) (exesToBuild lp))
  where
   package = lp.package
 
 -- | Either build all executables or, if the user specifies requested
 -- components, just build them.
-exesToBuild :: LocalPackage -> Set Text
+exesToBuild :: LocalPackage -> Set StackUnqualCompName
 exesToBuild lp = if lp.wanted
   then exeComponents lp.components
   else buildableExes lp.package

src/Stack/Build/Source.hs

@@ -25,7 +25,7 @@ import qualified Pantry.SHA256 as SHA256
 import           Stack.Build.Cache ( tryGetBuildCache )
 import           Stack.Build.Haddock ( shouldHaddockDeps )
 import           Stack.Package
-                   ( buildableBenchmarksComp, buildableExesComp, buildableTestSuitesComp
+                   ( buildableBenchmarks, buildableExes, buildableTestSuites
                    , hasBuildableMainLibrary, resolvePackage
                    )
 import           Stack.PackageFile ( getPackageFile )
@@ -361,17 +361,17 @@ loadLocalPackage pp = do
             let (_s, e, t, b) = splitComponents $ Set.toList comps
             in  (e, t, b)
           Just (TargetAll _packageType) ->
-            ( buildableExesComp pkg
+            ( buildableExes pkg
             , if    bopts.tests
                  && maybe True (Set.notMember name . (.skipTest)) mcurator
-                then buildableTestSuitesComp pkg
+                then buildableTestSuites pkg
                 else Set.empty
             , if    bopts.benchmarks
                  && maybe
                       True
                       (Set.notMember name . (.skipBenchmark))
                       mcurator
-                then buildableBenchmarksComp pkg
+                then buildableBenchmarks pkg
                 else Set.empty
             )
           Nothing -> mempty
@@ -466,9 +466,9 @@ loadLocalPackage pp = do
       -- through component parsing, but the components aren't present, then they
       -- must not be buildable.
     , unbuildable = toComponents
-        (exes `Set.difference` buildableExesComp pkg)
-        (tests `Set.difference` buildableTestSuitesComp pkg)
-        (benches `Set.difference` buildableBenchmarksComp pkg)
+        (exes `Set.difference` buildableExes pkg)
+        (tests `Set.difference` buildableTestSuites pkg)
+        (benches `Set.difference` buildableBenchmarks pkg)
     }
 
 -- | Compare the current filesystem state to the cached information, and

src/Stack/Ghci.hs

@@ -46,8 +46,8 @@ import           Stack.Ghci.Script
                    , scriptToLazyByteString
                    )
 import           Stack.Package
-                   ( buildableForeignLibsComp, buildableSubLibsComp, buildableExesComp
-                   , buildableTestSuitesComp, buildableBenchmarksComp, getPackageOpts
+                   ( buildableForeignLibs, buildableSubLibs, buildableExes
+                   , buildableTestSuites, buildableBenchmarks, getPackageOpts
                    , hasBuildableMainLibrary, listOfPackageDeps
                    , packageFromPackageDescription, readDotBuildinfo
                    , resolvePackageDescription, topSortPackageComponent
@@ -957,15 +957,15 @@ wantedPackageComponents bopts (TargetAll PTProject) pkg =
          else S.empty
      )
   <> S.mapMonotonic CExe buildableExes'
-  <> S.mapMonotonic CSubLib buildableSubLibs
-  <> (if bopts.tests then S.mapMonotonic CTest buildableTestSuites else S.empty)
-  <> (if bopts.benchmarks then S.mapMonotonic CBench buildableBenchmarks else S.empty)
+  <> S.mapMonotonic CSubLib buildableSubLibs'
+  <> (if bopts.tests then S.mapMonotonic CTest buildableTestSuites' else S.empty)
+  <> (if bopts.benchmarks then S.mapMonotonic CBench buildableBenchmarks' else S.empty)
  where
-  buildableForeignLibs' = buildableForeignLibsComp pkg
-  buildableSubLibs = buildableSubLibsComp pkg
-  buildableExes' = buildableExesComp pkg
-  buildableTestSuites = buildableTestSuitesComp pkg
-  buildableBenchmarks = buildableBenchmarksComp pkg
+  buildableForeignLibs' = buildableForeignLibs pkg
+  buildableSubLibs' = buildableSubLibs pkg
+  buildableExes' = buildableExes pkg
+  buildableTestSuites' = buildableTestSuites pkg
+  buildableBenchmarks' = buildableBenchmarks pkg
 wantedPackageComponents _ _ _ = S.empty
 
 checkForIssues :: HasTerm env => [GhciPkgInfo] -> RIO env ()