module Control.Monad.HReader
       ( HReaderT(..)
       , runHReaderT
       , subHSetHReaderT
       , narrowHReaderT
       , module Control.Monad.HReader.Class
       ) where

import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Cont
import Control.Monad.HReader.Class
import Control.Monad.Morph
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Control
import Control.Monad.Writer
import Data.HSet
import Data.Typeable
import GHC.Generics

import qualified Control.Monad.Trans.Reader as Reader

#if MIN_VERSION_mtl(2, 2, 1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif

#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif

-- | Monad transformer which is like 'ReaderT' but for `HSet` only
newtype HReaderT els m a = HReaderT
    { forall (els :: [*]) (m :: * -> *) a.
HReaderT els m a -> ReaderT (HSet els) m a
unHReaderT :: ReaderT (HSet els) m a
    } deriving ( forall (els :: [*]) (m :: * -> *) a b.
Functor m =>
a -> HReaderT els m b -> HReaderT els m a
forall (els :: [*]) (m :: * -> *) a b.
Functor m =>
(a -> b) -> HReaderT els m a -> HReaderT els m b
forall a b. a -> HReaderT els m b -> HReaderT els m a
forall a b. (a -> b) -> HReaderT els m a -> HReaderT els m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HReaderT els m b -> HReaderT els m a
$c<$ :: forall (els :: [*]) (m :: * -> *) a b.
Functor m =>
a -> HReaderT els m b -> HReaderT els m a
fmap :: forall a b. (a -> b) -> HReaderT els m a -> HReaderT els m b
$cfmap :: forall (els :: [*]) (m :: * -> *) a b.
Functor m =>
(a -> b) -> HReaderT els m a -> HReaderT els m b
Functor, forall {els :: [*]} {m :: * -> *}.
Applicative m =>
Functor (HReaderT els m)
forall (els :: [*]) (m :: * -> *) a.
Applicative m =>
a -> HReaderT els m a
forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m a
forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m (a -> b) -> HReaderT els m a -> HReaderT els m b
forall (els :: [*]) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> HReaderT els m a -> HReaderT els m b -> HReaderT els m c
forall a. a -> HReaderT els m a
forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m a
forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
forall a b.
HReaderT els m (a -> b) -> HReaderT els m a -> HReaderT els m b
forall a b c.
(a -> b -> c)
-> HReaderT els m a -> HReaderT els m b -> HReaderT els m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m a
$c<* :: forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m a
*> :: forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
$c*> :: forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
liftA2 :: forall a b c.
(a -> b -> c)
-> HReaderT els m a -> HReaderT els m b -> HReaderT els m c
$cliftA2 :: forall (els :: [*]) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> HReaderT els m a -> HReaderT els m b -> HReaderT els m c
<*> :: forall a b.
HReaderT els m (a -> b) -> HReaderT els m a -> HReaderT els m b
$c<*> :: forall (els :: [*]) (m :: * -> *) a b.
Applicative m =>
HReaderT els m (a -> b) -> HReaderT els m a -> HReaderT els m b
pure :: forall a. a -> HReaderT els m a
$cpure :: forall (els :: [*]) (m :: * -> *) a.
Applicative m =>
a -> HReaderT els m a
Applicative, forall {els :: [*]} {m :: * -> *}.
Monad m =>
Applicative (HReaderT els m)
forall (els :: [*]) (m :: * -> *) a.
Monad m =>
a -> HReaderT els m a
forall (els :: [*]) (m :: * -> *) a b.
Monad m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
forall (els :: [*]) (m :: * -> *) a b.
Monad m =>
HReaderT els m a -> (a -> HReaderT els m b) -> HReaderT els m b
forall a. a -> HReaderT els m a
forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
forall a b.
HReaderT els m a -> (a -> HReaderT els m b) -> HReaderT els m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HReaderT els m a
$creturn :: forall (els :: [*]) (m :: * -> *) a.
Monad m =>
a -> HReaderT els m a
>> :: forall a b.
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
$c>> :: forall (els :: [*]) (m :: * -> *) a b.
Monad m =>
HReaderT els m a -> HReaderT els m b -> HReaderT els m b
>>= :: forall a b.
HReaderT els m a -> (a -> HReaderT els m b) -> HReaderT els m b
$c>>= :: forall (els :: [*]) (m :: * -> *) a b.
Monad m =>
HReaderT els m a -> (a -> HReaderT els m b) -> HReaderT els m b
Monad, forall {els :: [*]} {m :: * -> *}.
MonadIO m =>
Monad (HReaderT els m)
forall (els :: [*]) (m :: * -> *) a.
MonadIO m =>
IO a -> HReaderT els m a
forall a. IO a -> HReaderT els m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> HReaderT els m a
$cliftIO :: forall (els :: [*]) (m :: * -> *) a.
MonadIO m =>
IO a -> HReaderT els m a
MonadIO
               , MonadError e, forall {els :: [*]} {m :: * -> *}.
MonadCont m =>
Monad (HReaderT els m)
forall (els :: [*]) (m :: * -> *) a b.
MonadCont m =>
((a -> HReaderT els m b) -> HReaderT els m a) -> HReaderT els m a
forall a b.
((a -> HReaderT els m b) -> HReaderT els m a) -> HReaderT els m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> HReaderT els m b) -> HReaderT els m a) -> HReaderT els m a
$ccallCC :: forall (els :: [*]) (m :: * -> *) a b.
MonadCont m =>
((a -> HReaderT els m b) -> HReaderT els m a) -> HReaderT els m a
MonadCont, MonadWriter w
               , MonadState s, MonadBase b
               , forall {els :: [*]} {m :: * -> *}.
MonadThrow m =>
Monad (HReaderT els m)
forall (els :: [*]) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> HReaderT els m a
forall e a. Exception e => e -> HReaderT els m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> HReaderT els m a
$cthrowM :: forall (els :: [*]) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> HReaderT els m a
MonadThrow, forall {els :: [*]} {m :: * -> *}.
MonadCatch m =>
MonadThrow (HReaderT els m)
forall (els :: [*]) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
HReaderT els m a -> (e -> HReaderT els m a) -> HReaderT els m a
forall e a.
Exception e =>
HReaderT els m a -> (e -> HReaderT els m a) -> HReaderT els m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
HReaderT els m a -> (e -> HReaderT els m a) -> HReaderT els m a
$ccatch :: forall (els :: [*]) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
HReaderT els m a -> (e -> HReaderT els m a) -> HReaderT els m a
MonadCatch, forall {els :: [*]} {m :: * -> *}.
MonadMask m =>
MonadCatch (HReaderT els m)
forall (els :: [*]) (m :: * -> *) b.
MonadMask m =>
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
forall (els :: [*]) (m :: * -> *) a b c.
MonadMask m =>
HReaderT els m a
-> (a -> ExitCase b -> HReaderT els m c)
-> (a -> HReaderT els m b)
-> HReaderT els m (b, c)
forall b.
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
forall a b c.
HReaderT els m a
-> (a -> ExitCase b -> HReaderT els m c)
-> (a -> HReaderT els m b)
-> HReaderT els m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
HReaderT els m a
-> (a -> ExitCase b -> HReaderT els m c)
-> (a -> HReaderT els m b)
-> HReaderT els m (b, c)
$cgeneralBracket :: forall (els :: [*]) (m :: * -> *) a b c.
MonadMask m =>
HReaderT els m a
-> (a -> ExitCase b -> HReaderT els m c)
-> (a -> HReaderT els m b)
-> HReaderT els m (b, c)
uninterruptibleMask :: forall b.
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
$cuninterruptibleMask :: forall (els :: [*]) (m :: * -> *) b.
MonadMask m =>
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
mask :: forall b.
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
$cmask :: forall (els :: [*]) (m :: * -> *) b.
MonadMask m =>
((forall a. HReaderT els m a -> HReaderT els m a)
 -> HReaderT els m b)
-> HReaderT els m b
MonadMask
               , Typeable, forall (els :: [*]) (m :: * -> *) a x.
Rep (HReaderT els m a) x -> HReaderT els m a
forall (els :: [*]) (m :: * -> *) a x.
HReaderT els m a -> Rep (HReaderT els m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (els :: [*]) (m :: * -> *) a x.
Rep (HReaderT els m a) x -> HReaderT els m a
$cfrom :: forall (els :: [*]) (m :: * -> *) a x.
HReaderT els m a -> Rep (HReaderT els m a) x
Generic  )

runHReaderT :: HSet els -> HReaderT els m a -> m a
runHReaderT :: forall (els :: [*]) (m :: * -> *) a.
HSet els -> HReaderT els m a -> m a
runHReaderT HSet els
h (HReaderT ReaderT (HSet els) m a
r) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HSet els) m a
r HSet els
h

-- | Run a local reader with a subset of HSet elements.
subHSetHReaderT :: (Monad m, Applicative m, SubHSettable els subels)
                => HReaderT subels m a -> HReaderT els m a
subHSetHReaderT :: forall (m :: * -> *) (els :: [*]) (subels :: [*]) a.
(Monad m, Applicative m, SubHSettable els subels) =>
HReaderT subels m a -> HReaderT els m a
subHSetHReaderT HReaderT subels m a
hr = do
  HSet els
hset <- forall (m :: * -> *). MonadHReader m => m (HSet (MHRElements m))
askHSet
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (els :: [*]) (m :: * -> *) a.
HSet els -> HReaderT els m a -> m a
runHReaderT (forall (els :: [*]) (els2 :: [*]).
SubHSet els els2 =>
HSet els -> HSet els2
subHSet HSet els
hset) HReaderT subels m a
hr

{- | Convenient variant of 'subHSetHReaderT' with proxy type to make it
posible to run nested HReaderT in place without complex type
declarations, e.g.

@
narrowHReaderT (Proxy :: Proxy '[String, Int]) $ do
  doThingsWithString
  doThingsWithInt
  doThingsWithOtherStuff -- < this will not compile
@

-}

narrowHReaderT :: (Monad m, Applicative m, SubHSettable els subels)
               => proxy subels -> HReaderT subels m a -> HReaderT els m a
narrowHReaderT :: forall (m :: * -> *) (els :: [*]) (subels :: [*])
       (proxy :: [*] -> *) a.
(Monad m, Applicative m, SubHSettable els subels) =>
proxy subels -> HReaderT subels m a -> HReaderT els m a
narrowHReaderT proxy subels
_ = forall (m :: * -> *) (els :: [*]) (subels :: [*]) a.
(Monad m, Applicative m, SubHSettable els subels) =>
HReaderT subels m a -> HReaderT els m a
subHSetHReaderT

instance MonadTrans (HReaderT els) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> HReaderT els m a
lift = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadReader r m) => MonadReader r (HReaderT els m) where
  ask :: HReaderT els m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> HReaderT els m a -> HReaderT els m a
local r -> r
f HReaderT els m a
ma = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall a b. (a -> b) -> a -> b
$ do
    HSet els
h <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
      forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall a b. (a -> b) -> a -> b
$ forall (els :: [*]) (m :: * -> *) a.
HSet els -> HReaderT els m a -> m a
runHReaderT HSet els
h HReaderT els m a
ma

instance (Monad m, Applicative m) => MonadHReader (HReaderT els m) where
  type MHRElements (HReaderT els m) = els
  askHSet :: HReaderT els m (HSet (MHRElements (HReaderT els m)))
askHSet = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall r (m :: * -> *). MonadReader r m => m r
ask
  hlocal :: forall a.
(HSet (MHRElements (HReaderT els m))
 -> HSet (MHRElements (HReaderT els m)))
-> HReaderT els m a -> HReaderT els m a
hlocal HSet (MHRElements (HReaderT els m))
-> HSet (MHRElements (HReaderT els m))
f (HReaderT ReaderT (HSet els) m a
r) = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
Reader.local HSet (MHRElements (HReaderT els m))
-> HSet (MHRElements (HReaderT els m))
f ReaderT (HSet els) m a
r

deriving instance MFunctor (HReaderT els)
deriving instance MMonad (HReaderT els)

#if MIN_VERSION_monad_control(1, 0, 0)
instance MonadTransControl (HReaderT els) where
  type StT (HReaderT els) a = StT (ReaderT (HSet els)) a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (HReaderT els) -> m a) -> HReaderT els m a
liftWith Run (HReaderT els) -> m a
action = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (ReaderT (HSet els))
runTrans -> Run (HReaderT els) -> m a
action (Run (ReaderT (HSet els))
runTrans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (els :: [*]) (m :: * -> *) a.
HReaderT els m a -> ReaderT (HSet els) m a
unHReaderT)
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (HReaderT els) a) -> HReaderT els m a
restoreT = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance (MonadBaseControl b m) => MonadBaseControl b (HReaderT els m) where
  type StM (HReaderT els m) a = StM (ReaderT (HSet els) m) a
  liftBaseWith :: forall a. (RunInBase (HReaderT els m) b -> b a) -> HReaderT els m a
liftBaseWith RunInBase (HReaderT els m) b -> b a
action = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall a b. (a -> b) -> a -> b
$ do
    forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase (ReaderT (HSet els) m) b
runInBase -> RunInBase (HReaderT els m) b -> b a
action (RunInBase (ReaderT (HSet els) m) b
runInBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (els :: [*]) (m :: * -> *) a.
HReaderT els m a -> ReaderT (HSet els) m a
unHReaderT)
  restoreM :: forall a. StM (HReaderT els m) a -> HReaderT els m a
restoreM = forall (els :: [*]) (m :: * -> *) a.
ReaderT (HSet els) m a -> HReaderT els m a
HReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
#else
instance MonadTransControl (HReaderT els) where
  newtype StT (HReaderT els) a
    = HRtTT
      { unHRtTT :: StT (ReaderT (HSet els)) a
      }
  liftWith action = HReaderT $ do
    liftWith $ \runTrans -> do
      action ((HRtTT `liftM`) . runTrans . unHReaderT)
  restoreT st = HReaderT $ restoreT $ unHRtTT `liftM` st

instance (MonadBaseControl b m) => MonadBaseControl b (HReaderT els m) where
  newtype StM (HReaderT els m) a
    = HRtMT (StM (ReaderT (HSet els) m) a)
  liftBaseWith action = HReaderT $ do
    liftBaseWith $ \runInBase -> do
      action ((HRtMT `liftM`) . runInBase . unHReaderT)
  restoreM (HRtMT st) = HReaderT $ restoreM st
#endif