cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs

   1 module Test.Cabal.OutputNormalizer (
   2     NormalizerEnv (..),
   3     normalizeOutput,
   4     ) where
   5
   6 import Data.Monoid (Endo (..))
   7
   8 import Distribution.Version
   9 import Distribution.Text
  10 import Distribution.Pretty
  11 import Distribution.Package
  12 import Distribution.System
  13
  14 import Text.Regex.Base
  15 import Text.Regex.TDFA
  16 import Data.Array ((!))
  17
  18 import qualified Data.Foldable as F
  19
  20 normalizeOutput :: NormalizerEnv -> String -> String
  21 normalizeOutput nenv =
  22     -- Munge away .exe suffix on filenames (Windows)
  23     resub "([A-Za-z0-9.-]+)\\.exe" "\\1"
  24     -- Normalize backslashes to forward slashes to normalize
  25     -- file paths
  26   . map (\c -> if c == '\\' then '/' else c)
  27     -- Install path frequently has architecture specific elements, so
  28     -- nub it out
  29   . resub "Installing (.+) in .+" "Installing \\1 in <PATH>"
  30     -- Things that look like libraries
  31   . resub "libHS[A-Za-z0-9.-]+\\.(so|dll|a|dynlib)" "<LIBRARY>"
  32     -- look for PackageHash directories
  33   . resub "/(([A-Za-z0-9_]+)(-[A-Za-z0-9\\._]+)*)-[0-9a-f]{4,64}/"
  34           "/<PACKAGE>-<HASH>/"
  35     -- This is dumb but I don't feel like pulling in another dep for
  36     -- string search-replace.  Make sure we do this before backslash
  37     -- normalization!
  38   . resub (posixRegexEscape (normalizerGblTmpDir nenv) ++ "[a-z0-9\\.-]+") "<GBLTMPDIR>"
  39   . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "<TMPDIR>"
  40   . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
  41   . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
  42   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
  43     -- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G
  44     -- These installed packages will vary depending on GHC version
  45     -- Apply this before packageIdRegex, otherwise this regex doesn't match.
  46   . resub "[0-9]+(\\.[0-9]+)*/installed-[A-Za-z0-9.+]+"
  47           "<VERSION>/installed-<HASH>"
  48     -- incoming directories in the store
  49   . resub "/incoming/new-[0-9]+"
  50           "/incoming/new-<RAND>"
  51     -- Normalize architecture
  52   . resub (posixRegexEscape (display (normalizerPlatform nenv))) "<ARCH>"
  53     -- Some GHC versions are chattier than others
  54   . resub "^ignoring \\(possibly broken\\) abi-depends field for packages" ""
  55     -- Normalize the current GHC version.  Apply this BEFORE packageIdRegex,
  56     -- which will pick up the install ghc library (which doesn't have the
  57     -- date glob).
  58   . (if normalizerGhcVersion nenv /= nullVersion
  59         then resub (posixRegexEscape (display (normalizerGhcVersion nenv))
  60                         -- Also glob the date, for nightly GHC builds
  61                         ++ "(\\.[0-9]+)?"
  62                         -- Also glob the ABI hash, for GHCs which support it
  63                         ++ "(-[a-z0-9]+)?")
  64                    "<GHCVER>"
  65         else id)
  66   . normalizeBuildInfoJson
  67   . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv)
  68   -- hackage-security locks occur non-deterministically
  69   . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
  70   where
  71     sameDir = "(\\.((\\\\)+|\\/))*"
  72     packageIdRegex pid =
  73         resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?")
  74               (prettyShow (packageName pid) ++ "-<VERSION>")
  75
  76     normalizePathCmdOutput cabalInstallVersion =
  77       -- clear the ghc path out of all supported output formats
  78       resub ("compiler-path: " <> posixRegexEscape (normalizerGhcPath nenv))
  79           "compiler-path: <GHCPATH>"
  80       -- ghc compiler path is already covered by 'normalizeBuildInfoJson'
  81       . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display cabalInstallVersion) ++ "\"")
  82           "{\"cabal-version\":\"<CABAL_INSTALL_VER>\""
  83       -- Replace windows filepaths that contain `\\` in the json output.
  84       -- since we need to escape each '\' ourselves, these 8 backslashes match on exactly 2 backslashes
  85       -- in the test output.
  86       -- As the json output is escaped, we need to re-escape the path.
  87       . resub "\\\\\\\\" "\\"
  88
  89     -- 'build-info.json' contains a plethora of host system specific information.
  90     --
  91     -- This must happen before the root-dir normalisation.
  92     normalizeBuildInfoJson =
  93         -- Remove ghc path from show-build-info output
  94         resub ("\"path\":\"" <> posixRegexEscape (normalizerGhcPath nenv) <> "\"")
  95           "\"path\":\"<GHCPATH>\""
  96         -- Remove cabal version output from show-build-info output
  97       . resub ("{\"cabal-lib-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"")
  98               "{\"cabal-lib-version\":\"<CABALVER>\""
  99         -- Remove the package id for stuff such as:
 100         -- > "-package-id","base-4.14.0.0-<some-hash>"
 101         -- and replace it with:
 102         -- > "-package-id","<PACKAGEDEP>"
 103         --
 104         -- Otherwise, output can not be properly normalized as on MacOs we remove
 105         -- vowels from packages to make the names shorter.
 106         -- E.g. "another-framework-0.8.1.1" -> "nthr-frmwrk-0.8.1.1"
 107         --
 108         -- This makes it impossible to have a stable package id, thus remove it completely.
 109         -- Check manually in your test-cases if the package-id needs to be verified.
 110       . resub ("\"-package-id\",\"([^\"]*)\"")
 111               "\"-package-id\",\"<PACKAGEDEP>\""
 112
 113 data NormalizerEnv = NormalizerEnv
 114     { normalizerRoot          :: FilePath
 115     , normalizerTmpDir        :: FilePath
 116     , normalizerCanonicalTmpDir :: FilePath
 117     -- ^ May differ from 'normalizerTmpDir', especially e.g. on macos, where
 118     -- `/var` is a symlink for `/private/var`.
 119     , normalizerGblTmpDir     :: FilePath
 120     , normalizerGhcVersion    :: Version
 121     , normalizerGhcPath    :: FilePath
 122     , normalizerKnownPackages :: [PackageId]
 123     , normalizerPlatform      :: Platform
 124     , normalizerCabalVersion  :: Version
 125     , normalizerCabalInstallVersion :: Maybe Version
 126     }
 127
 128 posixSpecialChars :: [Char]
 129 posixSpecialChars = ".^$*+?()[{\\|"
 130
 131 posixRegexEscape :: String -> String
 132 posixRegexEscape = concatMap (\c -> if c `elem` posixSpecialChars then ['\\', c] else [c])
 133
 134 -- From regex-compat-tdfa by Christopher Kuklewicz and shelarcy, BSD-3-Clause
 135 -------------------------
 136
 137 resub :: String {- search -} -> String {- replace -} -> String {- input -} -> String
 138 resub _ _ "" = ""
 139 resub regexp repl inp =
 140   let compile _i str [] = \ _m ->  (str ++)
 141       compile i str (("\\", (off, len)) : rest) =
 142         let i' = off + len
 143             pre = take (off - i) str
 144             str' = drop (i' - i) str
 145         in if null str' then \ _m -> (pre ++) . ('\\' :)
 146              else \ m -> (pre ++) . ('\\' :) . compile i' str' rest m
 147       compile i str ((xstr, (off, len)) : rest) =
 148         let i' = off + len
 149             pre = take (off - i) str
 150             str' = drop (i' - i) str
 151             x = read xstr
 152         in if null str' then \ m -> (pre++) . (fst (m ! x) ++)
 153              else \ m -> (pre ++) . (fst (m ! x) ++) . compile i' str' rest m
 154       compiled :: MatchText String -> String -> String
 155       compiled = compile 0 repl findrefs where
 156         -- bre matches a backslash then capture either a backslash or some digits
 157         bre = mkRegex "\\\\(\\\\|[0-9]+)"
 158         findrefs = map (\m -> (fst (m ! 1), snd (m ! 0))) (matchAllText bre repl)
 159       go _i str [] = str
 160       go i str (m : ms) =
 161         let (_, (off, len)) = m ! 0
 162             i' = off + len
 163             pre = take (off - i) str
 164             str' = drop (i' - i) str
 165         in if null str' then pre ++ compiled m ""
 166              else pre ++ compiled m (go i' str' ms)
 167   in go 0 inp (matchAllText (mkRegex regexp) inp)
 168
 169 mkRegex :: String -> Regex
 170 mkRegex s = makeRegexOpts opt defaultExecOpt s
 171   where opt = defaultCompOpt { newSyntax = True, multiline = True }