Restore Frequency tests (#28)

Author: JordanMartinez

bower.json

@@ -30,6 +30,9 @@
   "devDependencies": {
     "purescript-assert": "master",
     "purescript-console": "master",
-    "purescript-lcg": "master"
+    "purescript-lcg": "master",
+    "purescript-arrays": "master",
+    "purescript-transformers": "master",
+    "purescript-math": "master"
   }
 }

test/Frequency.purs

@@ -0,0 +1,66 @@
+module Test.Frequency where
+
+import Prelude
+
+import Control.Monad.Gen (class MonadGen, frequency)
+import Control.Monad.State (State, class MonadState, get, put, evalStateT)
+import Data.Array (replicate, group', length)
+import Data.Array.NonEmpty (toNonEmpty)
+import Data.Newtype (unwrap)
+import Data.NonEmpty ((:|), NonEmpty(..))
+import Data.Traversable (sequence)
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Math (remainder)
+import Partial.Unsafe (unsafeCrashWith)
+import Test.Assert (assert)
+
+newtype TestGenFrequency a = TestGenFrequency (State Number a)
+derive newtype instance testGenFunctor :: Functor TestGenFrequency
+derive newtype instance testGenApply :: Apply TestGenFrequency
+derive newtype instance testGenBind :: Bind TestGenFrequency
+derive newtype instance testGenApplicative :: Applicative TestGenFrequency
+derive newtype instance testGenMonad :: Monad TestGenFrequency
+derive newtype instance testGenMonadState :: MonadState Number TestGenFrequency
+
+instance testGenMonadGen :: MonadGen TestGenFrequency where
+  sized _ = unsafeCrashWith "sized should not be called"
+  resize _ _ = unsafeCrashWith "resize should not be called"
+  chooseBool = pure unit >>= \_ -> unsafeCrashWith "chooseBool should not be called"
+  chooseFloat s e = do
+    c <- get
+    put (c + 1.0)
+    pure ((s + c) `remainder` e)
+  chooseInt _ _ = unsafeCrashWith "chooseFloat should not be called"
+
+runTestGenFrequency :: TestGenFrequency ~> State Number
+runTestGenFrequency (TestGenFrequency x) = x
+
+check :: Effect Unit
+check =
+  let
+    abcGen :: TestGenFrequency String
+    abcGen =
+      frequency $
+        ( Tuple 10.0 $ pure "A" ) :|
+        [ Tuple 20.0 $ pure "B"
+        , Tuple  0.0 $ pure "Z"
+        , Tuple 30.0 $ pure "C"
+        , Tuple 40.0 $ pure "D"
+        , Tuple 50.0 $ pure "E"
+        , Tuple 50.0 $ pure "F"
+        ]
+    abcArrGen = sequence $ replicate 200 abcGen
+    abcArr = runTestGenFrequency abcArrGen `evalStateT` 0.0 # unwrap
+    actual = group' abcArr <#> \nea -> case toNonEmpty nea of
+      NonEmpty x xs -> Tuple (length xs + 1) x
+    expected =
+      [ (Tuple 10 "A")
+      , (Tuple 20 "B")
+      , (Tuple 30 "C")
+      , (Tuple 40 "D")
+      , (Tuple 50 "E")
+      , (Tuple 50 "F")
+      ]
+  in
+    assert (expected == actual)

test/Main.purs

@@ -14,6 +14,7 @@ import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Class.Console (log)
 import Random.LCG as LCG
 import Test.Assert (assertEqual)
+import Test.Frequency as Frequency
 
 main :: Effect Unit
 main = do
@@ -32,6 +33,9 @@ main = do
     one :: NonEmpty Array Int ← Gen.resize (const 0) $ GenC.genNonEmpty (Gen.sized pure)
     liftEffect $ assertEqual { actual: one, expected: 0 :| [] }
 
+  log "check frequency"
+  Frequency.check
+
 --------------------------------------------------------------------------------
 
 type GenState = Tuple LCG.Seed Int