diff --git a/.hlint.yaml b/.hlint.yaml index 0170ee22ebd..a632e5b3b6f 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -49,7 +49,10 @@ - ignore: {name: "Use concatMap"} # 1 hint - ignore: {name: "Use const"} # 36 hints - ignore: {name: "Use elem"} # 2 hints +<<<<<<< HEAD - ignore: {name: "Use fewer imports"} # 19 hints +======= +>>>>>>> 217f08ac5 (Follow hlint suggestion: use fewer imports) - ignore: {name: "Use first"} # 4 hints - ignore: {name: "Use fmap"} # 24 hints - ignore: {name: "Use fold"} # 1 hint @@ -96,6 +99,12 @@ - arguments: - --ignore-glob=Cabal-syntax/src/Distribution/Fields/Lexer.hs +<<<<<<< HEAD +======= + - --ignore-glob=Cabal-tests/tests/custom-setup/CabalDoctestSetup.hs + - --ignore-glob=Cabal-tests/tests/custom-setup/IdrisSetup.hs + - --ignore-glob=cabal-testsuite/PackageTests/BuildWays/q/app/Main.hs +>>>>>>> 217f08ac5 (Follow hlint suggestion: use fewer imports) - --ignore-glob=cabal-testsuite/PackageTests/CmmSources/src/Demo.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs diff --git a/Cabal/src/Distribution/Compat/Internal/TempFile.hs b/Cabal/src/Distribution/Compat/Internal/TempFile.hs index 5d3683be079..89f8575b6e8 100644 --- a/Cabal/src/Distribution/Compat/Internal/TempFile.hs +++ b/Cabal/src/Distribution/Compat/Internal/TempFile.hs @@ -15,17 +15,17 @@ import System.FilePath (()) import System.IO (Handle, openBinaryTempFile, openTempFile) #if defined(__IO_MANAGER_WINIO__) import System.IO (openBinaryTempFileWithDefaultPermissions) +import System.Posix.Internals (c_getpid) #else import Control.Exception (onException) import Data.Bits ((.|.)) import Foreign.C (CInt, eEXIST, getErrno, errnoToIOError) import GHC.IO.Handle.FD (fdToHandle) -import System.Posix.Internals (c_open, c_close, o_EXCL, o_BINARY, withFilePath, +import System.Posix.Internals (c_getpid, c_open, c_close, o_EXCL, o_BINARY, withFilePath, o_CREAT, o_RDWR, o_NONBLOCK, o_NOCTTY) #endif import System.IO.Error (isAlreadyExistsError) -import System.Posix.Internals (c_getpid) #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) import System.Directory ( createDirectory ) diff --git a/Cabal/src/Distribution/Compat/Time.hs b/Cabal/src/Distribution/Compat/Time.hs index 088c01950c0..cce1ceaf819 100644 --- a/Cabal/src/Distribution/Compat/Time.hs +++ b/Cabal/src/Distribution/Compat/Time.hs @@ -41,13 +41,14 @@ import System.Win32.Types ( BOOL, DWORD, LPCTSTR, LPVOID, withTString ) #else -import System.Posix.Files ( FileStatus, getFileStatus ) - +import System.Posix.Files + ( FileStatus, getFileStatus #if MIN_VERSION_unix(2,6,0) -import System.Posix.Files ( modificationTimeHiRes ) + , modificationTimeHiRes #else -import System.Posix.Files ( modificationTime ) + , modificationTime #endif + ) #endif diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 17777b3f6db..0bd81875d72 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -125,24 +125,29 @@ import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension -import System.Directory - ( canonicalizePath - , createDirectoryIfMissing - , doesDirectoryExist - , doesFileExist - , getAppUserDataDirectory - , getDirectoryContents - ) import System.FilePath ( isRelative , takeDirectory ) import qualified System.Info #ifndef mingw32_HOST_OS -import System.Directory (renameFile) import System.Posix (createSymbolicLink) #endif /* mingw32_HOST_OS */ +{- FOURMOLU_DISABLE -} +import System.Directory + ( canonicalizePath + , createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + , getAppUserDataDirectory + , getDirectoryContents +#ifndef mingw32_HOST_OS + , renameFile +#endif + ) +{- FOURMOLU_ENABLE -} + import Distribution.Simple.Setup (BuildingWhat (..)) import Distribution.Simple.Setup.Build diff --git a/cabal-install/src/Distribution/Client/CmdTest.hs b/cabal-install/src/Distribution/Client/CmdTest.hs index 7c1adffdc91..3812bd6af87 100644 --- a/cabal-install/src/Distribution/Client/CmdTest.hs +++ b/cabal-install/src/Distribution/Client/CmdTest.hs @@ -33,7 +33,8 @@ import Distribution.Client.NixStyleOptions ) import Distribution.Client.ProjectOrchestration import Distribution.Client.Setup - ( ConfigFlags (..) + ( CommonSetupFlags (..) + , ConfigFlags (..) , GlobalFlags (..) ) import Distribution.Client.TargetProblem @@ -66,7 +67,6 @@ import Distribution.Verbosity import qualified System.Exit (exitSuccess) import Distribution.Client.Errors -import Distribution.Client.Setup (CommonSetupFlags (..)) import GHC.Environment ( getFullArgs ) diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 2faf9e1756d..bc3d37cacf2 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -49,7 +49,10 @@ module Distribution.Client.Config ) where import Distribution.Client.Compat.Prelude -import Distribution.Compat.Environment (lookupEnv) +import Distribution.Compat.Environment + ( getEnvironment + , lookupEnv + ) import Prelude () import Language.Haskell.Extension (Language (Haskell2010)) @@ -126,9 +129,6 @@ import Distribution.Client.Version ( cabalInstallVersion ) import qualified Distribution.Compat.CharParsing as P -import Distribution.Compat.Environment - ( getEnvironment - ) import Distribution.Compiler ( CompilerFlavor (..) , defaultCompilerFlavor diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 6ffbc97fcf3..33d89d6cd81 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} @@ -100,7 +99,18 @@ module Distribution.Client.ProjectPlanning ) where import Distribution.Client.Compat.Prelude -import Text.PrettyPrint (render) +import Text.PrettyPrint + ( colon + , comma + , fsep + , hang + , punctuate + , quotes + , render + , text + , vcat + , ($$) + ) import Prelude () import Distribution.Client.Config @@ -220,7 +230,6 @@ import qualified Data.Set as Set import Distribution.Client.Errors import Distribution.Solver.Types.ProjectConfigPath import System.FilePath -import Text.PrettyPrint (colon, comma, fsep, hang, punctuate, quotes, text, vcat, ($$)) import qualified Text.PrettyPrint as Disp -- | Check that an 'ElaboratedConfiguredPackage' actually makes diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 1b401ff6f7c..78833af6d15 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -143,7 +143,10 @@ import Distribution.Simple.Program.GHC , renderGhcOptions ) import Distribution.Simple.Setup - ( Flag (..), CommonSetupFlags (..), GlobalFlags (..) + ( CommonSetupFlags (..) + , Flag (..) + , GlobalFlags (..) + , globalCommand ) import Distribution.Simple.Utils ( cabalVersion @@ -175,7 +178,6 @@ import Distribution.Verbosity import Data.List (foldl1') import qualified Data.Map.Lazy as Map -import Distribution.Simple.Setup (globalCommand) import Distribution.Client.Compat.ExecutablePath (getExecutablePath) import Distribution.Compat.Process (proc) import System.Directory (doesFileExist) diff --git a/cabal-install/src/Distribution/Client/Store.hs b/cabal-install/src/Distribution/Client/Store.hs index 9ffe6099c7f..dcf4c78d02c 100644 --- a/cabal-install/src/Distribution/Client/Store.hs +++ b/cabal-install/src/Distribution/Client/Store.hs @@ -47,8 +47,7 @@ import System.FilePath import Lukko #else import System.IO (openFile, IOMode(ReadWriteMode), hClose) -import GHC.IO.Handle.Lock (hLock, hTryLock, LockMode(ExclusiveLock)) -import GHC.IO.Handle.Lock (hUnlock) +import GHC.IO.Handle.Lock (LockMode (ExclusiveLock), hLock, hTryLock, hUnlock) #endif -- $concurrency diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 4b0c6e46813..514b0f05a85 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -45,6 +45,19 @@ import qualified Distribution.Client.CmdBench as CmdBench import qualified Distribution.Client.CmdHaddock as CmdHaddock import qualified Distribution.Client.CmdListBin as CmdListBin +<<<<<<< HEAD +======= +import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject +import Distribution.Client.Config (SavedConfig (savedGlobalFlags), createDefaultConfigFile, loadConfig) +import Distribution.Client.GlobalFlags + ( GlobalFlags + , defaultGlobalFlags + , globalNix + ) +import Distribution.Client.Setup (globalCommand, globalStoreDir) +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import Distribution.ModuleName (ModuleName) +>>>>>>> 217f08ac5 (Follow hlint suggestion: use fewer imports) import Distribution.Package import Distribution.PackageDescription import Distribution.InstalledPackageInfo (InstalledPackageInfo) @@ -83,7 +96,11 @@ import Test.Tasty.Options import Data.Tagged (Tagged(..)) import qualified Data.ByteString as BS +<<<<<<< HEAD import Distribution.Client.GlobalFlags (GlobalFlags, globalNix) +======= +import Data.Maybe (fromJust) +>>>>>>> 217f08ac5 (Follow hlint suggestion: use fewer imports) import Distribution.Simple.Flag (Flag (Flag, NoFlag)) import Distribution.Types.ParStrat import Data.Maybe (fromJust) diff --git a/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs new file mode 100644 index 00000000000..0e8dfae9038 --- /dev/null +++ b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs @@ -0,0 +1,276 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Functions for searching for a needle in a haystack, with transformations +-- for the strings to search in and the search strings such as re-encoding line +-- breaks or delimiting lines. Both LF and CRLF line breaks are recognized. +module Test.Cabal.NeedleHaystack + ( TxContains(..) + , txContainsId + , NeedleHaystack(..) + , symNeedleHaystack + , multilineNeedleHaystack + , needleHaystack + , lineBreaksToSpaces + , normalizePathSeparators + , encodeLf + , delimitLines + ) where + +import Prelude hiding (unlines) +import qualified Prelude (unlines) +import Data.Maybe (isJust) +import Distribution.System +import Distribution.Utils.Generic (unsnoc) +import Data.List (isPrefixOf, tails) +import qualified System.FilePath.Posix as Posix +import qualified System.FilePath.Windows as Windows +import Network.URI (parseURI) + +{- +Note [Multiline Needles] +~~~~~~~~~~~~~~~~~~~~~~~~ + +How we search for multiline strings in output that varies by platform. + +Reading Expected Multiline Strings Verbatim +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +With @ghc-9.12.1@ adding @-XMultilineStrings@, writing multiline string +expectations for @cabal-testsuite/PackageTests/**/*.test.hs@ test scripts might +be have been easier but for a catch. We run these tests with older @GHC@ +versions so would need to use @-XCPP@ for those versions and the C preprocessor +does not play nicely with string gaps. While it is possible to encode a +multiline string as a single line with embedded LF characters or by breaking the +line up arbitrarily and using @++@ concatenation or by calling unlines on a list +of lines, string gaps are the multiline strings of Haskell prior to +@-XMultilineStrings@. + +To avoid these problems and for the convenience of pasting the expected value +verbatim into a file, @readFileVerbatim@ can read the expected multiline output +for tests from a text file. This has the same implementation as @readFile@ from +the @strict-io@ package to avoid problems at cleanup. + +Warning: Windows file locking hack: hit the retry limit 3 while trying to remove +C:\Users\\AppData\Local\Temp\cabal-testsuite-8376 +cabal.test.hs: +C:\Users\\AppData\Local\Temp\cabal-testsuite-8376\errors.expect.txt: removePathForcibly:DeleteFile +"\\\\?\\C:\\Users\\\\AppData\\Local\\Temp\\cabal-testsuite-8376\\errors.expect.txt": +permission denied (The process cannot access the file because it is being used by another process.) + +The other process accessing the file is @C:\WINDOWS\System32\svchost.exe@ +running a @QueryDirectory@ event and this problem only occurs when the test +fails. + +Hidden Actual Value Modification +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The @assertOutputContains@ function was modifying the actual value (the test +output) with @concatOutput@ before checking if it contained the expected value. +This function, now renamed as @lineBreaksToSpaces@, would remove CR values and +convert LF values to spaces. + +With this setup, false positives were possible. An expected value using string +gaps and spaces would match a @concatOutput@ modified actual value of +"foo_bar_baz", where '_' was any of space, LF or CRLF in the unmodified actual +value. The latter two are false positive matches. + +> let expect = "foo \ +> \bar \ +> \baz" + +False negatives were also possible. An expected value set up using string gaps +with LF characters or with @-XMultilineStrings@ wouldn't match an actual value +of "foo_bar_baz", where '_' was either LF or CRLF because these characters had +been replaced by spaces in the actual value, modified before the comparison. + +> let expect = "foo\n\ +> \bar\n\ +> \baz" + +> {-# LANGUAGE MultilineStrings #-} +> +> let expect = """ +> foo +> bar +> baz +> """ + +We had these problems: + +1. The actual value was changed before comparison and this change was not visible. +2. The expected value was not changed in the same way as the actual value. This + made it possible for equal values to become unequal (false negatives) and for + unequal values to become equal (false positives). + +Explicit Changes and Visible Line Delimiters +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +To fix these problems, an added @assertOn@ function takes a @NeedleHaystack@ +configuration for how the search is made, what to expect (to find the expected +value or not) and how to display the expected and actual values. + +A pilcrow ΒΆ is often used to visibly display line endings but our terminal +output is restricted to ASCII so lines are delimited between @^@ and @$@ +markers. The needle (the expected output fragment) is shown annotated this way +and the haystack (the actual output) can optionally be shown this way too. + +This is still a lenient match, allowing LF to match CRLF, but @encodeLf@ doesn't +replace LF with spaces like @concatOutput@ (@lineBreaksToSpaces@) did: + +If you choose to display the actual value by setting +@NeedleHaystack{displayHaystack = True}@ then its lines will be delimited. + +With @assertOn@, supplying string transformation to both the needle and haystack +before comparison and before display can help find out why an expected value is +or isn't found in the test output. +-} + +-- | Transformations for the search strings and the text to search in. +data TxContains = + TxContains + { + -- | Reverse conversion for display, applied to the forward converted value. + txBwd :: (String -> String), + -- | Forward conversion for comparison. + txFwd :: (String -> String) + } + +-- | Identity transformation for the search strings and the text to search in, +-- leaves them unchanged. +txContainsId :: TxContains +txContainsId = TxContains id id + +-- | Conversions of the needle and haystack strings, the seach string and the +-- text to search in. +data NeedleHaystack = + NeedleHaystack + { + expectNeedleInHaystack :: Bool, + displayHaystack :: Bool, + txNeedle :: TxContains, + txHaystack :: TxContains + } + +-- | Symmetric needle and haystack functions, the same conversion for each going +-- forward and the same coversion for each going backward. +symNeedleHaystack :: (String -> String) -> (String -> String) -> NeedleHaystack +symNeedleHaystack bwd fwd = let tx = TxContains bwd fwd in NeedleHaystack True False tx tx + +-- | Multiline needle and haystack functions with symmetric conversions. Going +-- forward converts line breaks to @"\\n"@. Going backward adds visible +-- delimiters to lines. +multilineNeedleHaystack :: NeedleHaystack +multilineNeedleHaystack = symNeedleHaystack delimitLines encodeLf + +-- | Minimal set up for finding the needle in the haystack. Doesn't change the +-- strings and doesn't display the haystack in any assertion failure message. +needleHaystack :: NeedleHaystack +needleHaystack = NeedleHaystack True False txContainsId txContainsId + +-- | Replace line breaks with spaces, correctly handling @"\\r\\n"@. +-- +-- >>> lineBreaksToSpaces "foo\nbar\r\nbaz" +-- "foo bar baz" +-- +-- >>> lineBreaksToSpaces "foo\nbar\r\nbaz\n" +-- "foo bar baz" +-- +-- >>> lineBreaksToSpaces "\nfoo\nbar\r\nbaz\n" +-- " foo bar baz" +lineBreaksToSpaces :: String -> String +lineBreaksToSpaces = unwords . lines . filter ((/=) '\r') + +-- | Replaces path separators found with those of the current OS, URL-like paths +-- excluded. +-- +-- > buildOS == Linux; normalizePathSeparators "foo\bar\baz" => "foo/bar/baz" +-- > buildOS == Windows; normalizePathSeparators "foo/bar/baz" => "foo\bar\baz" +normalizePathSeparators :: String -> String +normalizePathSeparators = + unlines . map normalizePathSeparator . lines + where + normalizePathSeparator p = + if | any (isJust . parseURI) (tails p) -> p + | buildOS == Windows -> + [if Posix.isPathSeparator c then Windows.pathSeparator else c| c <- p] + | otherwise -> + [if Windows.isPathSeparator c then Posix.pathSeparator else c| c <- p] + +-- | @unlines@ from base will add a trailing newline if there isn't one already +-- but this one doesn't +-- +-- >>> lines "abc" +-- ["abc"] +-- +-- >>> Data.List.unlines $ lines "abc" +-- "abc\n" +-- +-- >>> unlines $ lines "abc" +-- "abc" +unlines :: [String] -> String +unlines = maybe "" fst . unsnoc . Prelude.unlines + +-- | Replace line CRLF line breaks with LF line breaks. +-- +-- >>> encodeLf "foo\nbar\r\nbaz" +-- "foo\nbar\nbaz" +-- +-- >>> encodeLf "foo\nbar\r\nbaz\n" +-- "foo\nbar\nbaz\n" +-- +-- >>> encodeLf "\nfoo\nbar\r\nbaz\n" +-- "\nfoo\nbar\nbaz\n" +-- +-- >>> encodeLf "\n\n\n" +-- "\n\n\n" +encodeLf :: String -> String +encodeLf = filter (/= '\r') + +-- | Mark lines with visible delimiters, @^@ at the start and @$@ at the end. +-- +-- >>> delimitLines "" +-- "^$" +-- +-- >>> delimitLines "\n" +-- "^$\n" +-- +-- >>> delimitLines "\n\n" +-- "^$\n^$\n" +-- +-- >>> delimitLines "\n\n\n" +-- "^$\n^$\n^$\n" +-- +-- >>> delimitLines $ encodeLf "foo\nbar\r\nbaz" +-- "^foo$\n^bar$\n^baz$" +-- +-- >>> delimitLines $ encodeLf "foo\nbar\r\nbaz\n" +-- "^foo$\n^bar$\n^baz$\n" +-- +-- >>> delimitLines $ encodeLf "\nfoo\nbar\r\nbaz\n" +-- "^$\n^foo$\n^bar$\n^baz$\n" +delimitLines:: String -> String +delimitLines "" = "^$" +delimitLines "\n" = "^$\n" +delimitLines ('\n' : xs) = "^$\n" ++ delimitLines xs +delimitLines output = fixupStart . fixupEnd $ + foldr + (\c acc -> c : + if | "\n" == acc -> "$\n" + |("\n" `isPrefixOf` acc) -> "$\n^" ++ drop 1 acc + | otherwise -> acc + ) + "" + output + where + fixupStart :: String -> String + fixupStart s@[] = s + fixupStart s@('^' : _) = s + fixupStart s = '^' : s + + fixupEnd :: String -> String + fixupEnd s@[] = s + fixupEnd s@(reverse -> '$' : _) = s + fixupEnd s@(reverse -> '\n' : '$' : _) = s + fixupEnd s = s ++ "$"