Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Clear a STAN suggestion #6299

Merged
merged 1 commit into from
Oct 17, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 32 additions & 6 deletions src/Path/Extra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@
-- | Extra Path utilities.
module Path.Extra
( toFilePathNoTrailingSep
, dropRoot
, parseCollapsedAbsDir
, parseCollapsedAbsFile
, concatAndCollapseAbsDir
Expand All @@ -17,6 +16,10 @@ module Path.Extra
, forgivingResolveDir
, forgivingResolveFile
, forgivingResolveFile'
, splitDrive
, takeDrive
, dropDrive
, isDrive
) where

import Data.Time ( UTCTime )
Expand Down Expand Up @@ -89,11 +92,6 @@ collapseFilePath = FP.joinPath . reverse . foldl' go [] . FP.splitDirectories
checkPathSeparator [x] = FP.isPathSeparator x
checkPathSeparator _ = False

-- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on
-- Windows).
dropRoot :: Path Abs t -> Path Rel t
dropRoot (Path l) = Path (FP.dropDrive l)

-- | If given file in 'Maybe' does not exist, ensure we have 'Nothing'. This
-- is to be used in conjunction with 'forgivingAbsence' and
-- 'resolveFile'.
Expand Down Expand Up @@ -183,3 +181,31 @@ forgivingResolveFile' ::
-- ^ Path to resolve
-> m (Maybe (Path Abs File))
forgivingResolveFile' p = getCurrentDir >>= flip forgivingResolveFile p

-- The following functions may be added to a future version of the path package.
-- See https://github.com/commercialhaskell/path/pull/191

-- | Split an absolute path into a drive and, perhaps, a path. On POSIX, @/@ is
-- a drive.
splitDrive :: Path Abs t -> (Path Abs Dir, Maybe (Path Rel t))
splitDrive (Path fp) =
let (d, rest) = FP.splitDrive fp
mRest = if null rest then Nothing else Just (Path rest)
in (Path d, mRest)

-- | Get the drive from an absolute path. On POSIX, @/@ is a drive.
--
-- > takeDrive x = fst (splitDrive x)
takeDrive :: Path Abs t -> Path Abs Dir
takeDrive = fst . splitDrive

-- | Drop the drive from an absolute path. May result in 'Nothing' if the path
-- is just a drive.
--
-- > dropDrive x = snd (splitDrive x)
dropDrive :: Path Abs t -> Maybe (Path Rel t)
dropDrive = snd . splitDrive

-- | Is an absolute directory path a drive?
isDrive :: Path Abs Dir -> Bool
isDrive = isNothing . dropDrive
12 changes: 5 additions & 7 deletions src/Stack/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,6 @@ import Data.Conduit.Process.Typed ( createSource )
import Data.Conduit.Zlib ( ungzip )
import Data.List.Split ( splitOn )
import qualified Data.Map as Map
import Data.Maybe ( fromJust )
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
Expand All @@ -66,13 +65,12 @@ import Network.HTTP.StackClient
)
import Network.HTTP.Simple ( getResponseHeader )
import Path
( (</>), addExtension, filename, fromAbsDir, parent
, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile
, toFilePath
( (</>), addExtension, filename, parent, parseAbsDir
, parseAbsFile, parseRelDir, parseRelFile, toFilePath
)
import Path.CheckInstall ( warnInstallSearchPathIssues )
import Path.Extended ( fileExtension )
import Path.Extra ( toFilePathNoTrailingSep )
import Path.Extra ( takeDrive, toFilePathNoTrailingSep )
import Path.IO
( canonicalizePath, doesFileExist, ensureDir, executable
, getPermissions, ignoringAbsence, listDir, removeDirRecur
Expand Down Expand Up @@ -167,7 +165,7 @@ import Stack.Types.VersionedDownloadInfo
import qualified System.Directory as D
import System.Environment ( getExecutablePath, lookupEnv )
import System.IO.Error ( isPermissionError )
import System.FilePath ( searchPathSeparator, takeDrive )
import System.FilePath ( searchPathSeparator )
import qualified System.FilePath as FP
import System.Permissions ( setFileExecutable )
import System.Uname ( getRelease )
Expand Down Expand Up @@ -2351,7 +2349,7 @@ withUnpackedTarball7z name si archiveFile archiveType destDir = do
-- filepath length of more than 260 characters, which can be problematic for
-- 7-Zip even if Long Filepaths are enabled on Windows.
let tmpName = "stack-tmp"
destDrive = fromJust $ parseAbsDir $ takeDrive $ fromAbsDir destDir
destDrive = takeDrive destDir
ensureDir (parent destDir)
withRunInIO $ \run ->
-- We use a temporary directory in the same drive as that of 'destDir' to
Expand Down