{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

{- |

Module      :  Control.Monad.Resumable.Class
Copyright   :  Copyright Nicolas Frisby 2010
License     :  <http://creativecommons.org/licenses/by/3.0/>

Maintainer  :  nicolas.frisby@gmail.com
Stability   :  experimental
Portability :  non-portable (GHC extensions)

A class with an associated type for converting the phantom @scope@ type of the
'Control.Monad.Resumable.ResumableT' transformer.

-}

module Control.Monad.Resumable.Scoped where

import Control.Monad.Resumable
import Control.Monad.Cont (ContT)
import Control.Monad.Error (ErrorT)
import Control.Monad.List (ListT)
import Control.Monad.RWS (RWST)
import Control.Monad.Reader (ReaderT)
import Control.Monad.State (StateT)
import Control.Monad.Writer (WriterT)

import Unsafe.Coerce -- safe since we're only changing phantom types



-- | Token type for static scoping.
data Static = Static
-- | Token type for dynamic scoping.
data Dynamic = Dynamic



-- | Ascribes the 'Static' scoping token to a 'ResumableT' transformer.
asStatic :: ResumableT Static req res m a -> ResumableT Static req res m a
asStatic = id

-- | Ascribes the 'Dynamic' scoping token to a 'ResumableT' transformer.
asDynamic :: ResumableT Dynamic req res m a -> ResumableT Dynamic req res m a
asDynamic = id

-- | Ascribes the 'Static' scoping token to a monad transformer stack.
statically :: Scoped Static m =>
              (ScopedAs Static m a -> ScopedAs Static m b) -> m a -> m b
statically = scoped Static

-- | Ascribes the 'Dynamic' scoping token to a monad transformer stack.
dynamically :: Scoped Dynamic m =>
               (ScopedAs Dynamic m a -> ScopedAs Dynamic m b) -> m a -> m b
dynamically = scoped Dynamic



-- | Type class with an associated type for setting the @scope@ phantom of the
-- 'ResumableT' transformer.
class Scoped scope m where
  type ScopedAs scope m :: * -> *
  scoped :: scope -> (ScopedAs scope m a -> ScopedAs scope m b) -> m a -> m b
  scoped _ f = unsafeCoerce . f . unsafeCoerce

instance Scoped scope (ResumableT scope' req res m) where
  type ScopedAs scope (ResumableT scope' req res m) = ResumableT scope req res m

instance Scoped scope m => Scoped scope (ContT r m) where
  type ScopedAs scope (ContT r m) = ContT r (ScopedAs scope m)

instance Scoped scope m => Scoped scope (ErrorT e m) where
  type ScopedAs scope (ErrorT e m) = ErrorT e (ScopedAs scope m)

instance Scoped scope m => Scoped scope (ListT m) where
  type ScopedAs scope (ListT m) = ListT (ScopedAs scope m)

instance Scoped scope m => Scoped scope (RWST r w s m) where
  type ScopedAs scope (RWST r w s m) = RWST r w s (ScopedAs scope m)

instance Scoped scope m => Scoped scope (ReaderT r m) where
  type ScopedAs scope (ReaderT r m) = ReaderT r (ScopedAs scope m)

instance Scoped scope m => Scoped scope (StateT s m) where
  type ScopedAs scope (StateT s m) = StateT s (ScopedAs scope m)

instance Scoped scope m => Scoped scope (WriterT w m) where
  type ScopedAs scope (WriterT w m) = WriterT w (ScopedAs scope m)