@@ -31,6 +31,7 @@ import Data.ByteString.Lazy.Char8 qualified as BS
31
31
import Data.Char (isDigit , toLower , toUpper )
32
32
import Data.Int (Int64 )
33
33
import Data.List.Extra
34
+ import Data.Map qualified as Map
34
35
import Data.Maybe (isNothing , mapMaybe )
35
36
import Data.Text qualified as Text
36
37
import Data.Text.IO qualified as Text
@@ -515,14 +516,17 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
515
516
withTempDir $ \ tmp -> withLogLevel common. logLevel $ do
516
517
-- unpack relevant tar files (rpc_* directories only)
517
518
logInfo_ $ unwords [" unpacking json files from tarball" , tarFile, " into" , tmp]
518
- jsonFiles <-
519
- liftIO $ Tar. foldEntries (unpackIfRpc tmp) (pure [] ) throwAnyError checked
519
+ ( jsonFiles, sequenceMap) <-
520
+ liftIO $ Tar. foldEntries (unpackIfRpc tmp) (pure mempty ) throwAnyError checked
520
521
logInfo_ $ " RPC data:" <> show jsonFiles
522
+ logInfo_ $ " Sequence data:" <> show sequenceMap
521
523
522
524
-- we should not rely on the requests being returned in a sorted order and
523
525
-- should therefore sort them explicitly
524
- let requests = sort $ mapMaybe (stripSuffix " _request.json" ) jsonFiles
526
+ let requests = mapMaybe (stripSuffix " _request.json" ) $ sortBy (compareSequence sequenceMap ) jsonFiles
525
527
successMsg = if compareDetails then " matches expected" else " has expected type"
528
+
529
+ logInfo_ $ " Requests to be executed:" <> show (map (<> " _request.json" ) requests)
526
530
results <-
527
531
forM requests $ \ r -> do
528
532
mbError <- runRequest skt tmp jsonFiles r
@@ -542,8 +546,19 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
542
546
throwAnyError :: Either Tar. FormatError Tar. FileNameError -> IO a
543
547
throwAnyError = either throwIO throwIO
544
548
549
+ compareSequence :: Ord a => Ord b => Map. Map a b -> a -> a -> Ordering
550
+ compareSequence seqMap a b = case (Map. lookup a seqMap, Map. lookup b seqMap) of
551
+ (Nothing , Nothing ) -> compare a b
552
+ (Just {}, Nothing ) -> LT
553
+ (Nothing , Just {}) -> GT
554
+ (Just a', Just b') -> compare a' b'
555
+
545
556
-- unpack all */*.json files into dir and return their names
546
- unpackIfRpc :: FilePath -> Tar. Entry -> IO [FilePath ] -> IO [FilePath ]
557
+ unpackIfRpc ::
558
+ FilePath ->
559
+ Tar. Entry ->
560
+ IO ([FilePath ], Map. Map FilePath Int ) ->
561
+ IO ([FilePath ], Map. Map FilePath Int )
547
562
unpackIfRpc tmpDir entry acc = do
548
563
case splitFileName (Tar. entryPath entry) of
549
564
-- unpack all directories "<something>" containing "*.json" files
@@ -562,8 +577,12 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
562
577
-- current tarballs do not have dir entries, create dir here
563
578
createDirectoryIfMissing True $ tmpDir </> dir
564
579
BS. writeFile (tmpDir </> newPath) bs
565
- (newPath : ) <$> acc
566
- | otherwise ->
580
+ (first (newPath : )) <$> acc
581
+ | " sequence" `isInfixOf` dir
582
+ , Just (idx :: Int ) <- readMaybe file
583
+ , Tar. NormalFile bs _size <- Tar. entryContent entry ->
584
+ (second $ Map. insert (BS. unpack bs) idx) <$> acc
585
+ | otherwise -> do
567
586
-- skip anything else
568
587
acc
569
588
0 commit comments