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.

Sign up for GitHub

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

Jump to bottom

Use Directory.canonicalizePath to resolve --with-compiler #10113

Closed
wants to merge 4 commits into from
Closed

Use Directory.canonicalizePath to resolve --with-compiler #10113

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d883dc3
Use `Directory.canonicalizePath` to resolve `--with-compiler`
elland Jun 14, 2024
e9322cb
Merge branch 'master' into elland/canonicalize-with-compiler-flag
elland Jun 14, 2024
028da0d
Add changelog
elland Jun 15, 2024
a728896
Apply suggestions from code review
elland Jun 15, 2024
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
17 changes: 8 additions & 9 deletions cabal-install/src/Distribution/Client/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -256,10 +256,8 @@ import Distribution.Version

import Control.Exception (AssertionFailed, assert, try)
import Data.Monoid (Any (..))
import System.Directory
( doesFileExist
, withCurrentDirectory
)
import Data.Traversable (mapM)
import qualified System.Directory as Directory
import System.Environment (getEnvironment, getExecutablePath, getProgName)
import System.FilePath
( dropExtension
Expand Down Expand Up @@ -401,7 +399,7 @@ mainWorker args = do
++ " "
++ configFile
++ "\n"
exists <- doesFileExist configFile
exists <- Directory.doesFileExist configFile
unless exists $
putStrLn $
"This file will be generated with sensible "
Expand Down Expand Up @@ -1146,13 +1144,14 @@ listAction :: ListFlags -> [String] -> Action
listAction listFlags extraArgs globalFlags = do
let verbosity = fromFlag (listVerbosity listFlags)
config <- loadConfigOrSandboxConfig verbosity globalFlags
canonicalizedHcPath <- mapM Directory.canonicalizePath (listHcPath listFlags)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Are there any other places in cabal codebase where canonicalizePath or anything equivalent is called? Should there be more places? Is there a way to make it more likely that all places that need it have it, e.g., defining a function that does both listHcPath and canonicalizePath and partially hiding or deprecating listHcPath , if that's the context where many of the canonicalizePath calls (should) happen.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@Mikolaj Unfortunately I'm not familiar enough with the codebase to answer this accurately.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

yeah there's a fair amount of places where canonicalizePath and canonicalizePathNoThrow are used in cabal-install.

Should there be more places?

no idea yet

Is there a way to make it more likely that all places that need it have it

All CLI option data types should be built with it, yes. I feel like this is another PR however.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I feel like this is another PR however.

That's a good point. Maybe we could open a ticket so that we don't forget?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Using canonicalizePath helped with #9578.

cabal/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs

Lines 153 to 229 in 50d5e31

-- | Normalizes and canonicalizes a path removing '.' and '..' indirections.
-- Makes the path relative to the given directory (typically the project root)
-- instead of relative to the file it was imported from.
--
-- It converts paths like this:
-- @
-- └─ hops-0.project
-- └─ hops/hops-1.config
-- └─ ../hops-2.config
-- └─ hops/hops-3.config
-- └─ ../hops-4.config
-- └─ hops/hops-5.config
-- └─ ../hops-6.config
-- └─ hops/hops-7.config
-- └─ ../hops-8.config
-- └─ hops/hops-9.config
-- @
--
-- Into paths like this:
-- @
-- └─ hops-0.project
-- └─ hops/hops-1.config
-- └─ hops-2.config
-- └─ hops/hops-3.config
-- └─ hops-4.config
-- └─ hops/hops-5.config
-- └─ hops-6.config
-- └─ hops/hops-7.config
-- └─ hops-8.config
-- └─ hops/hops-9.config
-- @
--
-- That way we have @hops-8.config@ instead of
-- @./hops/../hops/../hops/../hops/../hops-8.config@.
--
-- Let's see how @canonicalizePath@ works that is used in the implementation
-- then we'll see how @canonicalizeConfigPath@ works.
--
-- >>> let d = testDir
-- >>> makeRelative d <$> canonicalizePath (d </> "hops/../hops/../hops/../hops/../hops-8.config")
-- "hops-8.config"
--
-- >>> let d = testDir
-- >>> p <- canonicalizeConfigPath d (ProjectConfigPath $ (d </> "hops/../hops/../hops/../hops/../hops-8.config") :| [])
-- >>> render $ docProjectConfigPath p
-- "hops-8.config"
--
-- >>> :{
-- do
-- let expected = unlines
-- [ "hops/hops-9.config"
-- , " imported by: hops-8.config"
-- , " imported by: hops/hops-7.config"
-- , " imported by: hops-6.config"
-- , " imported by: hops/hops-5.config"
-- , " imported by: hops-4.config"
-- , " imported by: hops/hops-3.config"
-- , " imported by: hops-2.config"
-- , " imported by: hops/hops-1.config"
-- , " imported by: hops-0.project"
-- ]
-- let d = testDir
-- let configPath = ProjectConfigPath ("hops/hops-9.config" :|
-- [ "../hops-8.config"
-- , "hops/hops-7.config"
-- , "../hops-6.config"
-- , "hops/hops-5.config"
-- , "../hops-4.config"
-- , "hops/hops-3.config"
-- , "../hops-2.config"
-- , "hops/hops-1.config"
-- , d </> "hops-0.project"])
-- p <- canonicalizeConfigPath d configPath
-- return $ expected == render (docProjectConfigPath p) ++ "\n"
-- :}
-- True
canonicalizeConfigPath :: FilePath -> ProjectConfigPath -> IO ProjectConfigPath

let configFlags' = savedConfigureFlags config
configFlags =
configFlags'
{ configPackageDBs =
configPackageDBs configFlags'
`mappend` listPackageDBs listFlags
, configHcPath = listHcPath listFlags
, configHcPath = canonicalizedHcPath
}
globalFlags' = savedGlobalFlags config `mappend` globalFlags
compProgdb <-
Expand Down Expand Up @@ -1305,7 +1304,7 @@ uploadAction uploadFlags extraArgs globalFlags = do
| otherwise =
sequence_
[ do
exists <- doesFileExist tarfile
exists <- Directory.doesFileExist tarfile
unless exists $ dieWithException verbosity $ FileNotFound tarfile
| tarfile <- tarfiles
]
Expand Down Expand Up @@ -1418,7 +1417,7 @@ initAction initFlags extraArgs globalFlags = do
[] -> initAction'
[projectDir] -> do
createDirectoryIfMissingVerbose verbosity True projectDir
withCurrentDirectory projectDir initAction'
Directory.withCurrentDirectory projectDir initAction'
_ -> dieWithException verbosity InitAction
where
initAction' = do
Expand Down Expand Up @@ -1450,7 +1449,7 @@ userConfigAction ucflags extraArgs globalFlags = do
case extraArgs of
("init" : _) -> do
path <- configFile
fileExists <- doesFileExist path
fileExists <- Directory.doesFileExist path
if (not fileExists || (fileExists && frc))
then void $ createDefaultConfigFile verbosity extraLines path
else dieWithException verbosity $ UserConfigAction path
Expand Down
10 changes: 10 additions & 0 deletions changelog.d/pr-10113
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
synopsis: Canonicalise path passed via `--with-compiler`.
packages: cabal-install
issues: #3411 #758
prs: #10113

description: {

* Cabal is now able to properly handle relative paths when using `--with-compiler` by canonicalising it instead of passing the relative path around, breaking when trying to resolve it outside of the current working directory.

}
Loading