Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Fuzzer monad
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
import Control.Applicative
import Control.Monad
import qualified Control.Monad.Random as R
import qualified Control.Monad.State as S
import qualified Control.Monad.Trans.Either as E
newtype Fuzzer s a = Fuzzer {
runFuzzer :: E.EitherT () (S.StateT s (R.Rand R.StdGen)) a
}
evalFuzzer :: Fuzzer s a -> s -> R.StdGen -> Either () a
evalFuzzer f s g = R.evalRand (S.evalStateT (E.runEitherT $ runFuzzer f) s) g
instance Functor (Fuzzer s) where
fmap f = Fuzzer . fmap f . runFuzzer
instance Applicative (Fuzzer s) where
pure = Fuzzer . pure
ff <*> fa = Fuzzer $ runFuzzer ff <*> runFuzzer fa
instance Monad (Fuzzer s) where
return = pure
ma >>= f = Fuzzer $ runFuzzer ma >>= (runFuzzer . f)
instance Alternative (Fuzzer s) where
empty = Fuzzer empty
fa <|> fb = Fuzzer $ runFuzzer fa <|> runFuzzer fb
instance MonadPlus (Fuzzer s) where
mzero = empty
mplus = (<|>)
instance R.MonadRandom (Fuzzer s) where
getRandom = Fuzzer R.getRandom
getRandoms = Fuzzer R.getRandoms
getRandomR = Fuzzer . R.getRandomR
getRandomRs = Fuzzer . R.getRandomRs
instance S.MonadState s (Fuzzer s) where
get = Fuzzer S.get
put = Fuzzer . S.put
try :: Fuzzer s a -> Fuzzer s a
try f = Fuzzer $ E.EitherT $ S.get >>= \s ->
E.eitherT ((S.put s >>) . return . Left) (return . Right) (runFuzzer f)
toss c = (R.getRandom >>= guard) >> return c
oneOf :: [Fuzzer s a] -> Fuzzer s a
oneOf fs = R.getRandomRs (0, length fs - 1) >>= msum . map (fs !!)
main = do
g <- R.getStdGen
let Right x = evalFuzzer (oneOf [toss "a", toss "b", toss "c"]) () g
putStrLn x
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.