NonDep.hs

module NonDep where

import Control.Monad.Random
import System.IO.Unsafe
import Data.List (nub)

type Env = Int
data NonDep a = ND {unND :: Rand StdGen (Env -> a)}

instance Monad NonDep where
  return x = ND $ uniform [const x]
  m >>= k = ND $ do
    alpha <- unND m
    return $ \r -> unsafePerformIO . evalRandIO $ unND (k (alpha r)) <*> return r
-- [\r -> f (k . alpha $ r) r | alpha <- m, f <- cfs]

instance Functor NonDep where
  fmap f m = m >>= return . f

instance Applicative NonDep where
  pure = return
  mf <*> mx = mf >>= \f -> mx >>= \x -> return (f x)


alts :: [a] -> NonDep a
alts xs = ND $ uniform $ map const xs

m :: NonDep Int
m = return 10

f,g :: Int -> NonDep Int
f = \x -> alts [x-1, x-2]
g = \x -> alts [x-5, x-7]

left, right :: IO (Env -> Int)
left  = evalRandIO . unND $ (m >>= f) >>= g
right = evalRandIO . unND $ m >>= (f >=> g)

main :: IO ()
main = do
  sequence (replicate 20 left) >>= \xs -> putStrLn ("LEFT: " ++ show (nub [x 0 | x <- xs]))
  sequence (replicate 20 right) >>= \xs -> putStrLn ("RIGHT: " ++ show (nub [x 0 | x <- xs]))