    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, IncoherentInstances, CPP #-}

    module Data.Random.Lift where

    import Data.RVar
    import qualified Data.Functor.Identity as T
    import qualified Control.Monad.Trans.Class as T

    #ifndef MTL2
    import qualified Control.Monad.Identity as MTL
    #endif

    -- | A class for \"liftable\" data structures. Conceptually
    -- an extension of 'T.MonadTrans' to allow deep lifting,
    -- but lifting need not be done between monads only. Eg lifting
    -- between 'Applicative's is allowed.
    --
    -- For instances where 'm' and 'n' have 'return'/'pure' defined,
    -- these instances must satisfy
    -- @lift (return x) == return x@.
    --
    -- This form of 'lift' has an extremely general type and is used primarily to
    -- support 'sample'.  Its excessive generality is the main reason it's not
    -- exported from "Data.Random".  'RVarT' is, however, an instance of
    -- 'T.MonadTrans', which in most cases is the preferred way
    -- to do the lifting.
    class Lift m n where
        lift :: m a -> n a

    instance (Monad m, T.MonadTrans t) => Lift m (t m) where
        lift :: forall a. m a -> t m a
    lift = m a -> t m a
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    T.lift

    instance Lift m m where
        lift :: forall a. m a -> m a
    lift = m a -> m a
    forall a. a -> a
    id

    -- | This instance is incoherent with the others. However,
    -- by the law @lift (return x) == return x@, the results
    -- must always be the same.
    instance Monad m => Lift T.Identity m where
        lift :: forall a. Identity a -> m a
    lift = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> m a) -> (Identity a -> a) -> Identity a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identity a -> a
    forall a. Identity a -> a
    T.runIdentity

    instance Lift (RVarT T.Identity) (RVarT m) where
        lift :: forall a. RVarT Identity a -> RVarT m a
    lift RVarT Identity a
    x = RVarT Identity a -> RGen -> RVarT m a
    forall g (m :: * -> *) a. StatefulGen g m => RVar a -> g -> m a
    runRVar RVarT Identity a
    x RGen
    RGen

    -- | This instance is again incoherent with the others, but provides a
    -- more-specific instance to resolve the overlap between the
    -- @Lift m (t m)@ and @Lift Identity m@ instances.
    instance T.MonadTrans t => Lift T.Identity (t T.Identity) where
        lift :: forall a. Identity a -> t Identity a
    lift = Identity a -> t Identity a
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    T.lift

    #ifndef MTL2

    -- | This instance is incoherent with the others. However,
    -- by the law @lift (return x) == return x@, the results
    -- must always be the same.
    instance Monad m => Lift MTL.Identity m where
        lift = return . MTL.runIdentity

    instance Lift (RVarT MTL.Identity) (RVarT m) where
        lift x = runRVarTWith (return . MTL.runIdentity) x RGen

    -- | This instance is again incoherent with the others, but provides a
    -- more-specific instance to resolve the overlap between the
    -- @Lift m (t m)@ and @Lift Identity m@ instances.
    instance T.MonadTrans t => Lift MTL.Identity (t MTL.Identity) where
        lift = T.lift

    #endif