fixup! fixup! fixup! fixup! fixup! Implements split and merge commands.

test/Test/IO/Regiment/IO.hs

@@ -40,7 +40,7 @@ import           Test.Regiment.Arbitrary
 
 import           Test.QuickCheck.Instances ()
 import           Test.QuickCheck.Jack (suchThat, property, forAllProperties, quickCheckWithResult)
-import           Test.QuickCheck.Jack (vectorOf, listOfN, maxSuccess, stdArgs, counterexample, (===), mkJack_)
+import           Test.QuickCheck.Jack (listOfN, maxSuccess, stdArgs, counterexample, (===), mkJack_)
 
 import           X.Control.Monad.Trans.Either (EitherT, newEitherT, runEitherT)
 
@@ -78,11 +78,9 @@ prop_roundtrip_write_read_line =
           return $ result === expected
 
 prop_regiment =
-  gamble (arbitrary `suchThat` (> 0)) $ \n ->
-  gamble genNonNullSeparator $ \sep ->
-  gamble (genRestrictedFormat sep) $ \fmt ->
-  gamble (genListSortColumns fmt) $ \sc ->
-  gamble (vectorOf n $ (mkJack_ $ genRow fmt) `suchThat` (not . BS.null)) $ \rs -> testIO $ do
+  gamble genRestrictedFormat $ \fmt ->
+  gamble (genSortColumns fmt) $ \sc ->
+  gamble (listOfN 1 100 $ (mkJack_ $ genRow fmt) `suchThat` (not . BS.null)) $ \rs -> testIO $ do
     withTempDirectory "dist" "regiment-test." $ \tmp -> do
       tmpFile <- writeToTmpFile tmp fmt rs
       success <- runEitherT $ regiment (InputFile tmpFile)
@@ -122,9 +120,10 @@ prop_regiment =
                 ExitFailure _ -> return $ counterexample ("diff failed: " <> so') False
 
 prop_regiment_split_merge =
-  gamble genNonNullSeparator $ \sep ->
-  gamble (genRestrictedFormat sep) $ \fmt ->
+  gamble genFormat $ \fmt ->
   gamble (listOfN 1 5 $ listOfN 1 100 $ (mkJack_ $ genRow fmt) `suchThat` (not . BS.null)) $ \vrs -> testIO $ do
+    -- sort on all columns to avoid having to deal with differences
+    -- in ordering of rows when sort keys are the same.
     let sc = SortColumn <$> [0 .. ((formatColumnCount fmt) - 1)]
     withTempDirectory "dist" "regiment-test." $ \tmp -> do
       chunkFiles <- mapM (writeToTmpFile tmp fmt) vrs

test/Test/Regiment/Arbitrary.hs

@@ -40,6 +40,35 @@ genKP numKeys =
     <$> Boxed.fromList <$> (vectorOf numKeys genKey)
     <*> genBytes
 
+genRealKP :: Format -> [SortColumn] -> Jack KeyedPayload
+genRealKP fmt sc = do
+  -- gen KeyedPayload using the gens from Parsley so that
+  -- we end up with an actual delimited or standardized payload
+
+  -- assume that sc is legit - i.e of length < formatColumnCount and
+  -- a subset of 1 .. formatColumnCount
+  fields <- vectorOf (formatColumnCount fmt) (genBytes)
+  let
+    sortkeys = DL.map (\i -> Key $ fields DL.!! (sortColumn i)) sc
+  return $ KeyedPayload {
+      keys = Boxed.fromList sortkeys
+    , payload = Parsley.renderRow fmt (Boxed.fromList fields) <> (renderNewline $ formatNewline fmt)
+  }
+
+genListKPsUniqueKeys :: Jack [[KeyedPayload]]
+genListKPsUniqueKeys = do
+  numKeys <- arbitrary `suchThat` (> 0)
+  numLists <- chooseInt (1,10)
+  maxListLength <- arbitrary `suchThat` (> 0)
+  forM [1 .. numLists] $ \i ->
+    genKPsUniqueKeys i numKeys maxListLength
+
+genListKPsNoPayload :: Jack [[KeyedPayload]]
+genListKPsNoPayload = do
+  numKeys <- arbitrary `suchThat` (> 0)
+  numLists <- chooseInt (1,10)
+  vectorOf numLists $ listOfN 0 numLists (genKPNoPayload numKeys)
+
 genKPNoPayload :: Int -> Jack KeyedPayload
 genKPNoPayload numKeys = do
   bs <- vectorOf numKeys genBytes
@@ -51,12 +80,6 @@ genKPNoPayload numKeys = do
     , payload = p
     }
 
-genListKPsNoPayload :: Jack [[KeyedPayload]]
-genListKPsNoPayload = do
-  numKeys <- arbitrary `suchThat` (> 0)
-  numLists <- chooseInt (1,10)
-  vectorOf numLists $ listOfN 0 numLists (genKPNoPayload numKeys)
-
 genKPsUniqueKeys :: Int -> Int -> Int -> Jack [KeyedPayload]
 genKPsUniqueKeys prefix numKeys maxListLength = do
   kps <- listOfN 0 maxListLength (genKP numKeys)
@@ -71,23 +94,15 @@ genKPsUniqueKeys prefix numKeys maxListLength = do
 
   return $ prepend uniquifier <$> kps
 
-genListKPsUniqueKeys :: Jack [[KeyedPayload]]
-genListKPsUniqueKeys = do
-  numKeys <- arbitrary `suchThat` (> 0)
-  numLists <- chooseInt (1,10)
-  maxListLength <- arbitrary `suchThat` (> 0)
-  forM [1 .. numLists] $ \i ->
-    genKPsUniqueKeys i numKeys maxListLength
-
 genCursor :: Int -> Handle -> Jack (Cursor Handle)
 genCursor n h =
   oneof [
       return EOF
     , NonEmpty <$> return h <*> (genKP n)
   ]
 
-genListSortColumns :: Format -> Jack [SortColumn]
-genListSortColumns fmt = do
+genSortColumns :: Format -> Jack [SortColumn]
+genSortColumns fmt = do
   sortcols <- sublistOf [0 .. ((formatColumnCount fmt) - 1)] `suchThat` (not . null)
   return $ SortColumn <$> sortcols
 
@@ -102,20 +117,6 @@ genField fmt =
       Standardized -> do
         genStandardizedField strBSlistOf1 sep
 
-genRealKP :: Format -> [SortColumn] -> Jack KeyedPayload
-genRealKP fmt sc = do
-  -- gen KeyedPayload using the gens from Parsley so that
-  -- we end up with an actual delimited or standardized payload
-
-  -- assume that sc is legit - i.e of length < formatColumnCount and
-  -- a subset of 1 .. formatColumnCount
-  fields <- vectorOf (formatColumnCount fmt) (genBytes)
-  let
-    sortkeys = DL.map (\i -> Key $ fields DL.!! (sortColumn i)) sc
-  return $ KeyedPayload {
-      keys = Boxed.fromList sortkeys
-    , payload = Parsley.renderRow fmt (Boxed.fromList fields) <> (renderNewline $ formatNewline fmt)
-  }
 
 strBSlistOf1 :: QC.Gen BS.ByteString
 strBSlistOf1 = fmap BSC.pack . QC.listOf1 . QC.elements $
@@ -125,9 +126,17 @@ genNonNullSeparator :: Jack Separator
 genNonNullSeparator =
   arbitrary `suchThat` (\sep -> sep /= (Separator . fromIntegral $ ord '\NUL'))
 
+genFormat :: Jack Format
+genFormat = do
+  sep <- genNonNullSeparator
+  arbitrary `suchThat` (\fmt ->
+                          (formatColumnCount fmt) > 0
+                       && (formatSeparator fmt) == sep
+                       )
 
-genRestrictedFormat :: Separator -> Jack Format
-genRestrictedFormat sep =
+genRestrictedFormat :: Jack Format
+genRestrictedFormat = do
+  sep <- genNonNullSeparator
   arbitrary `suchThat` (\fmt ->
                           (formatColumnCount fmt) > 0
                        && (formatKind fmt) == Delimited

test/Test/Regiment/Vanguard/List.hs

@@ -37,6 +37,11 @@ prop_runVanguard_unique_keys =
 
 prop_runVanguard_possible_dupe_sortkeys :: Property
 prop_runVanguard_possible_dupe_sortkeys =
+  -- by artificially removing payloads we are able to avoid
+  -- test that runVanguard is the same as DL.sort. Retaining
+  -- payloads means that we have to accomodate differences in
+  -- the ordering of payloads between runVanguard and DL.sort
+  -- when sort keys are exactly the same.
   runVanguardOn genListKPsNoPayload
 
 return []