{-# language RoleAnnotations #-}
{-# language MultiParamTypeClasses #-}
{-# language FlexibleInstances #-}
{-# language CPP #-}
module Control.Monad.ReaderIO
  (
    ReaderIO (..)
  )
  where

import Control.Monad.Fix
#if MIN_VERSION_base(4,10,0)
import Control.Applicative
#endif
import Control.Monad
import Control.Monad.Reader.Class
import Control.Monad.IO.Class

-- | An approximate clone of @RIO@ from the @rio@ package, but not based on
-- @ReaderT@. The trouble with @ReaderT@ is that its third type argument has a
-- @nominal@ role, so we can't coerce through it when it's wrapped in some
-- other @data@ type. Ugh.
newtype ReaderIO e a = ReaderIO { ReaderIO e a -> e -> IO a
runReaderIO :: e -> IO a }
type role ReaderIO representational representational

instance Functor (ReaderIO e) where
  fmap :: (a -> b) -> ReaderIO e a -> ReaderIO e b
fmap = (a -> b) -> ReaderIO e a -> ReaderIO e b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
  {-# INLINE fmap #-}
  a :: a
a <$ :: a -> ReaderIO e b -> ReaderIO e a
<$ m :: ReaderIO e b
m = ReaderIO e b
m ReaderIO e b -> ReaderIO e a -> ReaderIO e a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ReaderIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE (<$) #-}

instance Applicative (ReaderIO e) where
  pure :: a -> ReaderIO e a
pure a :: a
a = (e -> IO a) -> ReaderIO e a
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO ((e -> IO a) -> ReaderIO e a) -> (e -> IO a) -> ReaderIO e a
forall a b. (a -> b) -> a -> b
$ \_ -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE pure #-}
  <*> :: ReaderIO e (a -> b) -> ReaderIO e a -> ReaderIO e b
(<*>) = ReaderIO e (a -> b) -> ReaderIO e a -> ReaderIO e b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c) -> ReaderIO e a -> ReaderIO e b -> ReaderIO e c
liftA2 = (a -> b -> c) -> ReaderIO e a -> ReaderIO e b -> ReaderIO e c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
  {-# INLINE liftA2 #-}
#endif
  *> :: ReaderIO e a -> ReaderIO e b -> ReaderIO e b
(*>) = ReaderIO e a -> ReaderIO e b -> ReaderIO e b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
  {-# INLINE (*>) #-}

instance Monad (ReaderIO e) where
  ReaderIO q :: e -> IO a
q >>= :: ReaderIO e a -> (a -> ReaderIO e b) -> ReaderIO e b
>>= f :: a -> ReaderIO e b
f = (e -> IO b) -> ReaderIO e b
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO ((e -> IO b) -> ReaderIO e b) -> (e -> IO b) -> ReaderIO e b
forall a b. (a -> b) -> a -> b
$ \e :: e
e -> e -> IO a
q e
e IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> ReaderIO e b -> e -> IO b
forall e a. ReaderIO e a -> e -> IO a
runReaderIO (a -> ReaderIO e b
f a
a) e
e
  {-# INLINE (>>=) #-}

instance MonadFix (ReaderIO e) where
  mfix :: (a -> ReaderIO e a) -> ReaderIO e a
mfix f :: a -> ReaderIO e a
f = (e -> IO a) -> ReaderIO e a
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO ((e -> IO a) -> ReaderIO e a) -> (e -> IO a) -> ReaderIO e a
forall a b. (a -> b) -> a -> b
$ \e :: e
e -> (a -> IO a) -> IO a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> IO a) -> IO a) -> (a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \r :: a
r -> ReaderIO e a -> e -> IO a
forall e a. ReaderIO e a -> e -> IO a
runReaderIO (a -> ReaderIO e a
f a
r) e
e
  {-# INLINE mfix #-}

instance MonadIO (ReaderIO e) where
  liftIO :: IO a -> ReaderIO e a
liftIO m :: IO a
m = (e -> IO a) -> ReaderIO e a
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO ((e -> IO a) -> ReaderIO e a) -> (e -> IO a) -> ReaderIO e a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a
m
  {-# INLINE liftIO #-}

instance MonadReader e (ReaderIO e) where
  ask :: ReaderIO e e
ask = (e -> IO e) -> ReaderIO e e
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO e -> IO e
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE ask #-}
  local :: (e -> e) -> ReaderIO e a -> ReaderIO e a
local f :: e -> e
f (ReaderIO m :: e -> IO a
m) = (e -> IO a) -> ReaderIO e a
forall e a. (e -> IO a) -> ReaderIO e a
ReaderIO (e -> IO a
m (e -> IO a) -> (e -> e) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
f)
  {-# INLINE local #-}