Independence and Applicativeness

foo.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}

import Control.Applicative.Free
import Control.Monad
import Control.Monad.Free
import Control.Monad.Primitive
import System.Random.MWC.Probability (Prob)
import qualified System.Random.MWC.Probability as MWC

data ProbF r =
    BetaF Double Double (Double -> r)
  | BernoulliF Double (Bool -> r)
  deriving Functor

type Model = Free ProbF

type Sample = Ap Model

beta :: Double -> Double -> Model Double
beta a b = liftF (BetaF a b id)

bernoulli :: Double -> Model Bool
bernoulli p = liftF (BernoulliF p id)

coin :: Double -> Double -> Model Bool
coin a b = beta a b >>= bernoulli

eval :: PrimMonad m => Model a -> Prob m a
eval = iterM $ \case
  BetaF a b k    -> MWC.beta a b >>= k
  BernoulliF p k -> MWC.bernoulli p >>= k

independent :: f a -> Ap f a
independent = liftAp

evalIndependent :: PrimMonad m => Sample a -> Prob m a
evalIndependent = runAp eval

sample :: Sample a -> IO a
sample model = MWC.withSystemRandom . MWC.asGenIO $
  MWC.sample (evalIndependent model)

flips :: Sample (Bool, Bool)
flips = (,) <$> independent (coin 1 8) <*> independent (coin 8 1)