Class.hs

-- |
-- Copyright   : (c) 2010 Simon Meier
-- License     : GPL v3 (see LICENSE)
-- 
-- Maintainer  : Simon Meier <iridcode@gmail.com>
-- Portability : portable
--
-- Type-class abstracting computations that need a fresh name supply.
module Control.Monad.Fresh.Class (
  MonadFresh(..)
) where

import Control.Basics

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

import qualified Control.Monad.Trans.FastFresh    as Fast (FreshT, freshIdents)
import qualified Control.Monad.Trans.PreciseFresh as Precise (FreshT, freshIdent, freshIdents)

-- Added 'Applicative' until base states this hierarchy
class (Applicative m, Monad m) => MonadFresh m where
    -- | Get the integer of the next fresh identifier of this name.
    freshIdent  :: String   -- ^ Desired name
                -> m Integer

    -- | Get a number of fresh identifiers. This reserves the required number
    -- of identifiers on all names.
    freshIdents :: Integer    -- ^ Number of desired fresh identifiers.
                -> m Integer  -- ^ The first Fresh identifier.


instance (Functor m, Monad m) => MonadFresh (Fast.FreshT m) where
    freshIdent _name = Fast.freshIdents 1
    freshIdents      = Fast.freshIdents

instance (Functor m, Monad m) => MonadFresh (Precise.FreshT m) where
    freshIdent  = Precise.freshIdent
    freshIdents = Precise.freshIdents


----------------------------------------------------------------------------
-- instances for other mtl transformers
--
-- TODO: Add remaining ones

instance MonadFresh m => MonadFresh (MaybeT m) where
    freshIdent  = lift . freshIdent
    freshIdents = lift . freshIdents

instance MonadFresh m => MonadFresh (StateT s m) where
    freshIdent  = lift . freshIdent
    freshIdents = lift . freshIdents

instance MonadFresh m => MonadFresh (ReaderT r m) where
    freshIdent  = lift . freshIdent
    freshIdents = lift . freshIdents

instance (Monoid w, MonadFresh m) => MonadFresh (WriterT w m) where
    freshIdent  = lift . freshIdent
    freshIdents = lift . freshIdents