{-# 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 = 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 = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = 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