Feature/monadic api tests 2

.gitignore

@@ -28,3 +28,4 @@ bin/
 coverage-html
 .DS_Store
 flake.lock
+tags

dataframe.cabal

@@ -201,7 +201,8 @@ test-suite tests
                    Operations.Subset,
                    Operations.Statistics,
                    Operations.Take,
-                   Parquet
+                   Parquet,
+                   Monad
     build-depends:  base >= 4 && < 5,
                     dataframe ^>= 0.4,
                     directory >= 1.3.0.0 && < 2,

tests/GenDataFrame.hs

@@ -21,7 +21,7 @@ genColumn len =
 
 genDataFrame :: Gen DataFrame
 genDataFrame = do
-    numRows <- choose (0, 100)
+    numRows <- choose (100, 1000)
     numCols <- choose (0, 10)
     colNames <- V.fromList <$> vectorOf numCols genUniqueColName
     cols <- V.fromList <$> vectorOf numCols (genColumn numRows)

tests/Main.hs

@@ -1,23 +1,24 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Main where
 
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Data.Vector.Unboxed as VU
-import qualified DataFrame as D
-import qualified DataFrame.Internal.Column as DI
+import qualified Data.Text                   as T
+import qualified Data.Vector                 as V
+import qualified Data.Vector.Unboxed         as VU
+import qualified DataFrame                   as D
+import qualified DataFrame.Internal.Column   as DI
 import qualified DataFrame.Operations.Typing as D
-import qualified System.Exit as Exit
+import qualified System.Exit                 as Exit
 
-import Data.Time
-import GenDataFrame ()
-import Test.HUnit
-import Test.QuickCheck
+import           Data.Time
+import           GenDataFrame                ()
+import           Test.HUnit
+import           Test.QuickCheck
 
 import qualified Functions
+import qualified Monad
 import qualified Operations.Aggregations
 import qualified Operations.Apply
 import qualified Operations.Core
@@ -5128,7 +5129,7 @@ tests =
 
 isSuccessful :: Result -> Bool
 isSuccessful (Success{..}) = True
-isSuccessful _ = False
+isSuccessful _             = False
 
 main :: IO ()
 main = do
@@ -5138,6 +5139,10 @@ main = do
         mapM
             (quickCheckWithResult stdArgs)
             Operations.Subset.tests
-    if failures result > 0 || errors result > 0 || not (all isSuccessful propRes)
+    monadRes <- mapM (quickCheckWithResult stdArgs) Monad.tests
+    if failures result > 0
+        || errors result > 0
+        || not (all isSuccessful propRes)
+        || not (all isSuccessful monadRes)
         then Exit.exitFailure
         else Exit.exitSuccess

tests/Monad.hs

@@ -0,0 +1,38 @@
+module Monad where
+
+import qualified DataFrame as D
+import DataFrame.Internal.DataFrame
+import DataFrame.Monad
+import Debug.Trace
+import GenDataFrame ()
+import System.Random
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+
+roundToTwoPlaces x = fromIntegral (round (x * 100)) / 100.0
+
+prop_sampleM :: DataFrame -> Property
+prop_sampleM df = monadicIO $ do
+    p <- run $ generate (choose (0.0 :: Double, 1.0 :: Double))
+    let expectedRate = roundToTwoPlaces p
+    seed <- run $ generate (choose (0, 1000))
+    let rowCount = D.nRows df
+    pre (rowCount > 100 && expectedRate > 0.1 && expectedRate < 0.8)
+    traceM $ "Rows in initialDf: " ++ show rowCount
+    -- traceM $ show df
+    let finalDf = execFrameM df (sampleM (mkStdGen seed) expectedRate)
+    let finalRowCount = D.nRows finalDf
+    let realRate = roundToTwoPlaces $ fromIntegral finalRowCount / fromIntegral rowCount
+    traceM $
+        "Rows in finalDf: "
+            ++ show finalRowCount
+            ++ "; expectedRate is "
+            ++ show realRate
+            ++ " where "
+            ++ show expectedRate
+            ++ " was expected"
+    let diff = abs $ expectedRate - realRate
+    traceM $ "Diff is " ++ show diff
+    assert (diff <= 0.1)
+
+tests = [prop_sampleM]