diff --git a/bower.json b/bower.json index ef6e505..c614821 100644 --- a/bower.json +++ b/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" } } diff --git a/test/Frequency.purs b/test/Frequency.purs new file mode 100644 index 0000000..b563b2b --- /dev/null +++ b/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) diff --git a/test/Main.purs b/test/Main.purs index 3b77ba0..4df4af3 100644 --- a/test/Main.purs +++ b/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