From b477512865a0e66ba0205a3c834079b0123c4812 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 21 Dec 2024 08:29:55 -0500 Subject: [PATCH] Add module Test.Cabal.NeedleHaystack --- cabal-testsuite/cabal-testsuite.cabal | 1 + .../src/Test/Cabal/NeedleHaystack.hs | 101 ++++++++++++++++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 100 +---------------- 3 files changed, 104 insertions(+), 98 deletions(-) create mode 100644 cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 0f3383af38a..2dd8090252e 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -45,6 +45,7 @@ library Test.Cabal.CheckArMetadata Test.Cabal.DecodeShowBuildInfo Test.Cabal.Monad + Test.Cabal.NeedleHaystack Test.Cabal.OutputNormalizer Test.Cabal.Plan Test.Cabal.Prelude diff --git a/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs new file mode 100644 index 00000000000..7b2b1fd76fa --- /dev/null +++ b/cabal-testsuite/src/Test/Cabal/NeedleHaystack.hs @@ -0,0 +1,101 @@ +module Test.Cabal.NeedleHaystack where + +import Data.List (isPrefixOf) + +-- | 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) + } + +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 + +multilineNeedleHaystack :: NeedleHaystack +multilineNeedleHaystack = symNeedleHaystack decodeLfMarkLines encodeLf + +-- | Needle and haystack functions that do not change the strings. Set up for +-- finding the needle in the haystack and not displaying the line-delimited +-- haystack. +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') + +-- | Replace line breaks with , correctly handling "\r\n". +-- +-- >>> encodeLf "foo\nbar\r\nbaz" +-- "foobarbaz" +-- +-- >>> encodeLf "foo\nbar\r\nbaz\n" +-- "foobarbaz" +-- +-- >>> encodeLf "\nfoo\nbar\r\nbaz\n" +-- "foobarbaz" +encodeLf :: String -> String +encodeLf = + (\s -> if "" `isPrefixOf` s then drop 5 s else s) + . concat + . (fmap ("" ++)) + . lines + . filter ((/=) '\r') + +-- | Replace markers with line breaks and wrap lines with ^ and $ markers +-- for the start and end. +-- +-- >>> decodeLfMarkLines "foobarbaz" +-- "^foo$\n^bar$\n^baz$\n" +-- +-- >>> decodeLfMarkLines "foobarbaz" +-- "^foo$\n^bar$\n^baz$\n" +decodeLfMarkLines:: String -> String +decodeLfMarkLines output = + (\xs -> case reverse $ lines xs of + [] -> xs + [line0] -> line0 ++ "$" + lineN : ys -> + let lineN' = lineN ++ "$" + in unlines $ reverse (lineN' : ys)) + . unlines + . (fmap ('^' :)) + . lines + . (\s -> if "" `isPrefixOf` s then drop 5 s else s) + $ foldr + (\c acc -> c : + if ("" `isPrefixOf` acc) + then "$\n" ++ drop 5 acc + else acc + ) + "" + output diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 656bd41e95b..31d4f3c758b 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -11,6 +11,7 @@ module Test.Cabal.Prelude ( module Test.Cabal.Prelude, module Test.Cabal.Monad, + module Test.Cabal.NeedleHaystack, module Test.Cabal.Run, module System.FilePath, module Distribution.Utils.Path, @@ -20,6 +21,7 @@ module Test.Cabal.Prelude ( module Distribution.Simple.Program, ) where +import Test.Cabal.NeedleHaystack import Test.Cabal.Script import Test.Cabal.Run import Test.Cabal.Monad @@ -797,44 +799,6 @@ recordMode mode = withReaderT (\env -> env { testRecordUserMode = Just mode }) --- | 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) - } - -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 - -multilineNeedleHaystack :: NeedleHaystack -multilineNeedleHaystack = symNeedleHaystack decodeLfMarkLines encodeLf - --- | Needle and haystack functions that do not change the strings. Set up for --- finding the needle in the haystack and not displaying the line-delimited --- haystack. -needleHaystack :: NeedleHaystack -needleHaystack = NeedleHaystack True False txContainsId txContainsId - assertOn :: MonadIO m => WithCallStack (NeedleHaystack -> String -> Result -> m ()) assertOn NeedleHaystack{..} (txFwd txNeedle -> needle) (txFwd txHaystack. resultOutput -> output) = withFrozenCallStack $ @@ -912,66 +876,6 @@ assertNoFileContains paths needle = \path -> assertFileDoesNotContain path needle --- | 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') - --- | Replace line breaks with , correctly handling "\r\n". --- --- >>> encodeLf "foo\nbar\r\nbaz" --- "foobarbaz" --- --- >>> encodeLf "foo\nbar\r\nbaz\n" --- "foobarbaz" --- --- >>> encodeLf "\nfoo\nbar\r\nbaz\n" --- "foobarbaz" -encodeLf :: String -> String -encodeLf = - (\s -> if "" `isPrefixOf` s then drop 5 s else s) - . concat - . (fmap ("" ++)) - . lines - . filter ((/=) '\r') - --- | Replace markers with line breaks and wrap lines with ^ and $ markers --- for the start and end. --- --- >>> decodeLfMarkLines "foobarbaz" --- "^foo$\n^bar$\n^baz$\n" --- --- >>> decodeLfMarkLines "foobarbaz" --- "^foo$\n^bar$\n^baz$\n" -decodeLfMarkLines:: String -> String -decodeLfMarkLines output = - (\xs -> case reverse $ lines xs of - [] -> xs - [line0] -> line0 ++ "$" - lineN : ys -> - let lineN' = lineN ++ "$" - in unlines $ reverse (lineN' : ys)) - . unlines - . (fmap ('^' :)) - . lines - . (\s -> if "" `isPrefixOf` s then drop 5 s else s) - $ foldr - (\c acc -> c : - if ("" `isPrefixOf` acc) - then "$\n" ++ drop 5 acc - else acc - ) - "" - output - -- | The directory where script build artifacts are expected to be cached getScriptCacheDirectory :: FilePath -> TestM FilePath getScriptCacheDirectory script = do