Merge pull request #6614 from theobat/refactoring-toward-cabal

Refactoring toward cabal

Author: mpilgrem

.stan.toml

@@ -83,14 +83,14 @@
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-tuE+RG-234:24"
+  id = "OBS-STAN-0203-tuE+RG-236:24"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Build\ExecutePackage.hs
 #
-#   233 ┃
-#   234 ┃   newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL
-#   235 ┃                        ^^^^^^^
+#   235 ┃
+#   236 ┃   newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL
+#   237 ┃                        ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]

package.yaml

@@ -83,6 +83,7 @@ dependencies:
 - fsnotify >= 0.4.1
 - generic-deriving
 - ghc-boot
+- hashable
 - hi-file-parser >= 0.1.6.0
 - hpack >= 0.36.0
 - hpc

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,11 @@ 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 +29,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,9 +51,10 @@ 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
-                   )
+                   ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
 import           Stack.Types.EnvConfig
                    ( EnvConfig (..), HasEnvConfig (..), HasSourceMap
@@ -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

@@ -35,7 +35,6 @@ import qualified Data.ByteArray as Mem ( convert )
 import           Data.ByteString.Builder ( byteString )
 import qualified Data.Map as M
 import qualified Data.Set as Set
-import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import           Foreign.C.Types ( CTime )
 import           Path ( (</>), filename, parent, parseRelFile )
@@ -63,6 +62,8 @@ 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 (..) )
@@ -74,10 +75,11 @@ import           Stack.Types.EnvConfig
 import           Stack.Types.GhcPkgId ( ghcPkgIdString )
 import           Stack.Types.Installed
                    (InstalledLibraryInfo (..), foldOnGhcPkgId' )
-import           Stack.Types.NamedComponent ( NamedComponent (..) )
+import           Stack.Types.NamedComponent
+                   ( NamedComponent (..), componentCachePath )
 import           Stack.Types.SourceMap ( smRelDir )
 import           System.PosixCompat.Files
-                   ( modificationTime, getFileStatus, setFileTimes )
+                   ( getFileStatus, modificationTime, setFileTimes )
 
 -- | Directory containing files to mark an executable as installed
 exeInstalledDir :: (HasEnvConfig env)
@@ -134,14 +136,7 @@ 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 $ case component of
-    CLib -> "lib"
-    CSubLib name -> nonLibComponent "sub-lib" name
-    CFlib name -> nonLibComponent "flib" name
-    CExe name -> nonLibComponent "exe" name
-    CTest name -> nonLibComponent "test" name
-    CBench name -> nonLibComponent "bench" name
+  cacheFileName <- parseRelFile $ componentCachePath component
   pure $ cachesDir </> smDirName </> cacheFileName
 
 -- | Try to read the dirtiness cache for the given package directory.
@@ -376,7 +371,7 @@ writePrecompiledCache ::
   -> ConfigureOpts
   -> Bool -- ^ build haddocks
   -> Installed -- ^ library
-  -> Set Text -- ^ executables
+  -> Set StackUnqualCompName -- ^ executables
   -> RIO env ()
 writePrecompiledCache
     baseConfigOpts
@@ -390,7 +385,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/ConstructPlan.hs

@@ -59,6 +59,7 @@ import           Stack.Types.CompCollection ( collectionMember )
 import           Stack.Types.Compiler ( WhichCompiler (..) )
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
+import           Stack.Types.ComponentUtils ( unqualCompFromText )
 import           Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
 import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
 import qualified Stack.Types.ConfigureOpts as ConfigureOpts
@@ -1182,7 +1183,8 @@ checkAndWarnForUnknownTools p = do
   -- From Cabal 1.12, build-tools can specify another executable in the same
   -- package.
   notPackageExe toolName =
-    MaybeT $ skipIf $ collectionMember toolName p.executables
+    MaybeT $ skipIf $
+      collectionMember (unqualCompFromText toolName) p.executables
   warn name = MaybeT . pure . Just $ ToolWarning (ExeName name) p.name
   skipIf p' = pure $ if p' then Nothing else Just ()
 

src/Stack/Build/Execute.hs

@@ -64,6 +64,8 @@ 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 +164,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 +262,7 @@ executePlan
 
 copyExecutables ::
        HasEnvConfig env
-    => Map Text InstallLocation
+    => Map StackUnqualCompName InstallLocation
     -> RIO env ()
 copyExecutables exes | Map.null exes = pure ()
 copyExecutables exes = do
@@ -283,23 +285,24 @@ copyExecutables exes = do
   currExe <- liftIO getExecutablePath -- needed for windows, see below
 
   installed <- forMaybeM (Map.toList exes) $ \(name, loc) -> do
-    let bindir =
+    let strName = unqualCompToString name
+        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 +314,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 +324,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