Re #2407 Move useSHA out of Stack.Types.Config

src/Stack/Constants/Config.hs

@@ -28,11 +28,9 @@ import           Stack.Constants ( cabalPackageName )
 import           Stack.Prelude
 import           Stack.Types.BuildConfig ( HasBuildConfig, projectRootL )
 import           Stack.Types.CompilerPaths ( cabalVersionL )
-import           Stack.Types.Config
-                   ( Config, HasConfig, stackRootL, useShaPathOnWindows
-                   , workDirL
-                   )
-import           Stack.Types.EnvConfig ( HasEnvConfig, platformGhcRelDir )
+import           Stack.Types.Config ( Config, HasConfig, stackRootL, workDirL )
+import           Stack.Types.EnvConfig
+                   ( HasEnvConfig, platformGhcRelDir, useShaPathOnWindows )
 
 -- | Output .o/.hi directory.
 objectInterfaceDirL :: HasBuildConfig env => Getting r env (Path Abs Dir)

src/Stack/Ghci.hs

@@ -49,7 +49,9 @@ import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
 import           Stack.Types.Config
 import           Stack.Types.EnvConfig
-                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL )
+                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
+                   , shaPathForBytes
+                   )
 import           Stack.Types.NamedComponent
 import           Stack.Types.Package
 import           Stack.Types.PackageFile

src/Stack/Types/Config.hs

@@ -40,9 +40,6 @@ module Stack.Types.Config
   , GlobalInfoSource (..)
   , docDirSuffix
   , platformOnlyRelDir
-  , useShaPathOnWindows
-  , shaPath
-  , shaPathForBytes
   , workDirL
   , ghcInstallHook
   -- * Command-related types
@@ -69,29 +66,22 @@ module Stack.Types.Config
   , to
   ) where
 
-import           Crypto.Hash ( SHA1 (..), hashWith )
 import           Pantry.Internal.AesonExtended
                    ( FromJSON (..), ToJSON (..), Value, WithJSONWarnings (..)
                    , (.=), (...:), (..:?), (..!=), jsonSubWarnings
                    , jsonSubWarningsT, jsonSubWarningsTT, object
                    , withObjectWarnings
                    )
-import qualified Data.ByteArray.Encoding as Mem ( Base(Base16), convertToBase )
-import qualified Data.ByteString.Char8 as S8
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import           Distribution.System ( Platform )
 import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
 import           Options.Applicative ( ReadM )
 import qualified Options.Applicative.Types as OA
-import           Path
-                   ( (</>), parent, parseAbsDir, parseAbsFile, parseRelDir
-                   , parseRelFile, reldir, relfile
-                   )
+import           Path ( (</>), parent, reldir, relfile )
 import           RIO.Process ( HasProcessContext (..), ProcessContext )
-import           Stack.Constants ( bindirSuffix, docDirSuffix, osIsWindows )
+import           Stack.Constants ( bindirSuffix, docDirSuffix )
 import           Stack.Prelude
 import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
 import           Stack.Types.CabalConfigKey ( CabalConfigKey )
@@ -389,40 +379,6 @@ ghcInstallHook = do
   hd <- hooksDir
   pure (hd </> [relfile|ghc-install.sh|])
 
--- | This is an attempt to shorten Stack paths on Windows to decrease our
--- chances of hitting 260 symbol path limit. The idea is to calculate
--- SHA1 hash of the path used on other architectures, encode with base
--- 16 and take first 8 symbols of it.
-useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
-useShaPathOnWindows
-  | osIsWindows = shaPath
-  | otherwise = pure
-
-shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
-shaPath = shaPathForBytes . encodeUtf8 . T.pack . toFilePath
-
-shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
-shaPathForBytes
-  = parsePath . S8.unpack . S8.take 8
-  . Mem.convertToBase Mem.Base16 . hashWith SHA1
-
--- TODO: Move something like this into the path package. Consider
--- subsuming path-io's 'AnyPath'?
-class IsPath b t where
-  parsePath :: MonadThrow m => FilePath -> m (Path b t)
-
-instance IsPath Abs Dir where
-  parsePath = parseAbsDir
-
-instance IsPath Rel Dir where
-  parsePath = parseRelDir
-
-instance IsPath Abs File where
-  parsePath = parseAbsFile
-
-instance IsPath Rel File where
-  parsePath = parseRelFile
-
 -- | Where do we get information on global packages for loading up a
 -- 'LoadedSnapshot'?
 data GlobalInfoSource

src/Stack/Types/EnvConfig.hs

@@ -22,14 +22,23 @@ module Stack.Types.EnvConfig
   , platformSnapAndCompilerRel
   , shouldForceGhcColorFlag
   , snapshotsDir
+  , useShaPathOnWindows
+  , shaPathForBytes
   ) where
 
+import           Crypto.Hash ( SHA1 (..), hashWith )
+import qualified Data.ByteArray.Encoding as Mem ( Base(Base16), convertToBase )
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.Text as T
 import qualified Distribution.Text ( display )
 import           Distribution.Version ( mkVersion )
-import           Path ( (</>), parseRelDir )
+import           Path
+                   ( (</>), parseAbsDir, parseAbsFile, parseRelDir
+                   , parseRelFile
+                   )
 import           RIO.Process ( HasProcessContext (..) )
 import           Stack.Constants
-                   ( bindirSuffix, ghcColorForceFlag, relDirCompilerTools
+                   ( bindirSuffix, ghcColorForceFlag, osIsWindows, relDirCompilerTools
                    , relDirHoogle, relDirHpc, relDirInstall, relDirPkgdb
                    , relDirSnapshots, relFileDatabaseHoo
                    )
@@ -41,8 +50,7 @@ import           Stack.Types.Compiler
 import           Stack.Types.CompilerBuild ( compilerBuildSuffix )
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
-import           Stack.Types.Config
-                    ( HasConfig (..), stackRootL, useShaPathOnWindows )
+import           Stack.Types.Config ( HasConfig (..), stackRootL )
 import           Stack.Types.Config.Build ( BuildOptsCLI )
 import           Stack.Types.GHCVariant ( HasGHCVariant (..), ghcVariantSuffix )
 import           Stack.Types.Platform
@@ -275,3 +283,37 @@ platformGhcVerOnlyRelDirStr = do
   pure $ mconcat [ Distribution.Text.display platform
                    , platformVariantSuffix platformVariant
                    , ghcVariantSuffix ghcVariant ]
+
+-- | This is an attempt to shorten Stack paths on Windows to decrease our
+-- chances of hitting 260 symbol path limit. The idea is to calculate
+-- SHA1 hash of the path used on other architectures, encode with base
+-- 16 and take first 8 symbols of it.
+useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir)
+useShaPathOnWindows
+  | osIsWindows = shaPath
+  | otherwise = pure
+
+shaPath :: (IsPath Rel t, MonadThrow m) => Path Rel t -> m (Path Rel t)
+shaPath = shaPathForBytes . encodeUtf8 . T.pack . toFilePath
+
+shaPathForBytes :: (IsPath Rel t, MonadThrow m) => ByteString -> m (Path Rel t)
+shaPathForBytes
+  = parsePath . S8.unpack . S8.take 8
+  . Mem.convertToBase Mem.Base16 . hashWith SHA1
+
+-- TODO: Move something like this into the path package. Consider
+-- subsuming path-io's 'AnyPath'?
+class IsPath b t where
+  parsePath :: MonadThrow m => FilePath -> m (Path b t)
+
+instance IsPath Abs Dir where
+  parsePath = parseAbsDir
+
+instance IsPath Rel Dir where
+  parsePath = parseRelDir
+
+instance IsPath Abs File where
+  parsePath = parseAbsFile
+
+instance IsPath Rel File where
+  parsePath = parseRelFile