Commit 1b0560c6 authored by Lennart Kolmodin's avatar Lennart Kolmodin Committed by GitHub
Browse files

Only use portable isAbsolute/isRelative when we have to. (#3822)

Only use the platform independent heuristics when we have to.
Also rename the functions to isAbsoluteOnAnyPlatform and isRelativeOnAnyPlatform
to make the distinction clearer.
parent 9c14b642
......@@ -626,7 +626,7 @@ checkSourceRepos pkg =
++ "field. It should specify the tag corresponding to this version "
++ "or release of the package."
, check (maybe False isAbsolute (repoSubdir repo)) $
, check (maybe False isAbsoluteOnAnyPlatform (repoSubdir repo)) $
PackageDistInexcusable
"The 'subdir' field of a source-repository must be a relative path."
]
......@@ -872,7 +872,7 @@ checkPaths pkg =
[ PackageDistInexcusable $
quote (kind ++ ": " ++ path) ++ " is an absolute path."
| (path, kind) <- relPaths
, isAbsolute path ]
, isAbsoluteOnAnyPlatform path ]
++
[ PackageDistInexcusable $
quote (kind ++ ": " ++ path) ++ " points inside the 'dist' "
......@@ -1755,7 +1755,7 @@ checkLocalPathsExist ops pkg = do
| dir <- extraFrameworkDirs bi ]
++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
, isRelative dir ]
, isRelativeOnAnyPlatform dir ]
missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs
return [ PackageBuildWarning {
explanation = quote (kind ++ ": " ++ dir)
......
......@@ -114,7 +114,7 @@ import Numeric ( showIntAtBase )
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.FilePath
( (</>) )
( (</>), isAbsolute )
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
......
......@@ -92,7 +92,8 @@ import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension )
, takeDirectory, replaceExtension
,isRelative )
import qualified System.Info
-- -----------------------------------------------------------------------------
......
......@@ -57,7 +57,8 @@ import Distribution.Compat.Semigroup (All (..), Any (..))
import Data.Either ( rights )
import System.Directory (doesFileExist)
import System.FilePath ( (</>), (<.>), normalise, splitPath, joinPath )
import System.FilePath ( (</>), (<.>), normalise, splitPath, joinPath
, isAbsolute )
import System.IO (hClose, hPutStr, hPutStrLn, hSetEncoding, utf8)
-- ------------------------------------------------------------------------------
......
......@@ -29,7 +29,7 @@ import Distribution.Simple.BuildPaths (haddockName, haddockPref)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
, installDirectoryContents, installOrdinaryFile, isInSearchPath
, die, info, notice, warn, matchDirFileGlob, isRelative )
, die, info, notice, warn, matchDirFileGlob )
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.Simple.Setup
......@@ -47,7 +47,7 @@ import Distribution.Compat.Graph (IsNode(..))
import System.Directory
( doesDirectoryExist, doesFileExist )
import System.FilePath
( takeFileName, takeDirectory, (</>) )
( takeFileName, takeDirectory, (</>), isRelative )
import Distribution.Verbosity
import Distribution.Text
......
......@@ -75,7 +75,7 @@ import Distribution.Text
import Distribution.Verbosity as Verbosity
import Distribution.Compat.Graph (IsNode(nodeKey))
import System.FilePath ((</>), (<.>))
import System.FilePath ((</>), (<.>), isAbsolute)
import System.Directory
import Data.Version
......
......@@ -63,7 +63,7 @@ import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import System.Directory ( doesFileExist )
import System.IO (IOMode(WriteMode), hPutStrLn, withFile)
import System.FilePath ((</>), (<.>), dropExtension)
import System.FilePath ((</>), (<.>), dropExtension, isRelative)
-- |Create a source distribution.
sdist :: PackageDescription -- ^information from the tarball
......
......@@ -147,8 +147,8 @@ module Distribution.Simple.Utils (
wrapLine,
-- * FilePath stuff
isAbsolute,
isRelative,
isAbsoluteOnAnyPlatform,
isRelativeOnAnyPlatform,
) where
import Prelude ()
......@@ -1594,7 +1594,9 @@ unintersperse mark = unfoldr unintersperse1 where
-- * FilePath stuff
-- ------------------------------------------------------------
-- | 'isAbsolute' and 'isRelative' has platform independent heuristic.
-- | 'isAbsoluteOnAnyPlatform' and 'isRelativeOnAnyPlatform' are like
-- 'System.FilePath.isAbsolute' and 'System.FilePath.isRelative' but have
-- platform independent heuristics.
-- The System.FilePath exists in two versions, Windows and Posix. The two
-- versions don't agree on what is a relative path and we don't know if we're
-- given Windows or Posix paths.
......@@ -1604,15 +1606,22 @@ unintersperse mark = unfoldr unintersperse1 where
-- System.FilePath.Windows.isAbsolute \"/hello\" == False
-- This means that we would treat paths that start with \"/\" to be absolute.
-- On Posix they are indeed absolute, while on Windows they are not.
isAbsolute :: FilePath -> Bool
--
-- The portable versions should be used when we might deal with paths that
-- are from another OS than the host OS. For example, the Hackage Server
-- deals with both Windows and Posix paths while performing the
-- PackageDescription checks. In contrast, when we run 'cabal configure' we
-- do expect the paths to be correct for our OS and we should not have to use
-- the platform independent heuristics.
isAbsoluteOnAnyPlatform :: FilePath -> Bool
-- C:\\directory
isAbsolute (drive:':':'\\':_) = isAlpha drive
isAbsoluteOnAnyPlatform (drive:':':'\\':_) = isAlpha drive
-- UNC
isAbsolute ('\\':'\\':_) = True
isAbsoluteOnAnyPlatform ('\\':'\\':_) = True
-- Posix root
isAbsolute ('/':_) = True
isAbsolute _ = False
isAbsoluteOnAnyPlatform ('/':_) = True
isAbsoluteOnAnyPlatform _ = False
-- | @isRelative = not . 'isAbsolute'@
isRelative :: FilePath -> Bool
isRelative = not . isAbsolute
\ No newline at end of file
-- | @isRelativeOnAnyPlatform = not . 'isAbsoluteOnAnyPlatform'@
isRelativeOnAnyPlatform :: FilePath -> Bool
isRelativeOnAnyPlatform = not . isAbsoluteOnAnyPlatform
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment