{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Prompt (P, Prompt, runP, newPrompt, eqPrompt) where

import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Trans

import Unsafe.Coerce

-- This implements the P/Prompt code from the Dybvig, Petyon-Jones, Sabry paper,
-- only as a monad transformer, and using the StateT monad (for the clever
-- deriving). I also switched to using unsafeCoerce rather than implementing it
-- with unsafePerformIO as they do in the paper.

data Prompt r a = Prompt Int

eqPrompt :: Prompt r a -> Prompt r b -> Maybe (a -> b, b -> a)
eqPrompt (Prompt i) (Prompt j)
    | i == j    = Just (unsafeCoerce id, unsafeCoerce id)
    | otherwise = Nothing

newtype P r m a = P { unP :: StateT Int m a }
    deriving (Functor, Monad, MonadState Int, MonadTrans, MonadReader e,
                MonadWriter w, MonadPlus)

runP :: Monad m => (forall r. P r m a) -> m a
runP ps = evalStateT (unP ps) 0

newPrompt :: Monad m => P r m (Prompt r a)
newPrompt = do i <- get ; put (i + 1) ; return (Prompt i)