リストモナドのEff版的な

gistfile1.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Main where

newtype Eff a = Eff { runEff :: forall w. (a -> VE w) -> VE w }
instance Monad Eff where
  --return :: a -> Eff a
  return x = Eff $ \k -> k x
  --(>>=) :: Eff a -> (a -> Eff b) -> Eff b
  m >>= f = let
    -- :: (b -> VE w) -> a -> VE w
    f0 k v = runEff (f v) k
    -- :: (b -> VE w) -> VE w
    m0 k = runEff m (f0 k)
    in Eff m0 -- :: Eff b

data VE w = Val w | forall a. E [a] (a -> VE w)

runVE :: VE w -> [w]
runVE (Val x) = [x]
runVE (E xs f) = concatMap (runVE . f) $ xs

-- Val   :            a -> VE a
-- m     : forall w. (a -> VE w) -> VE w
-- m Val :                          VE a
admin :: Eff w -> VE w
admin (Eff m) = m Val

runChoose :: Eff w -> [w]
runChoose m = runVE $ admin m

choose :: [w] -> Eff w
choose xs = Eff $ \k -> E xs k

test :: [(Int, Int)]
test = runChoose test'

test' :: Eff (Int, Int)
test' = do
  x <- choose [1,2,3]
  y <- choose [10,20,30]
  return (x, y)