git.iko.soy/reflex
on ae@dev-script help sign in
reflex/src/Control/Monad/ReaderIO.hs
60 lines 1.6 kB history raw
1{-# language RoleAnnotations #-}
2{-# language MultiParamTypeClasses #-}
3{-# language FlexibleInstances #-}
4{-# language CPP #-}
5module Control.Monad.ReaderIO
6 (
7 ReaderIO (..)
8 )
9 where
11import Control.Monad.Fix
12#if MIN_VERSION_base(4,10,0)
13import Control.Applicative
14#endif
15import Control.Monad
16import Control.Monad.Reader.Class
17import Control.Monad.IO.Class
19-- | An approximate clone of @RIO@ from the @rio@ package, but not based on
20-- @ReaderT@. The trouble with @ReaderT@ is that its third type argument has a
21-- @nominal@ role, so we can't coerce through it when it's wrapped in some
22-- other @data@ type. Ugh.
23newtype ReaderIO e a = ReaderIO { runReaderIO :: e -> IO a }
24type role ReaderIO representational representational
26instance Functor (ReaderIO e) where
27 fmap = liftM
28 {-# INLINE fmap #-}
29 a <$ m = m >> pure a
30 {-# INLINE (<$) #-}
32instance Applicative (ReaderIO e) where
33 pure a = ReaderIO $ \_ -> pure a
34 {-# INLINE pure #-}
35 (<*>) = ap
36 {-# INLINE (<*>) #-}
37#if MIN_VERSION_base(4,10,0)
38 liftA2 = liftM2
39 {-# INLINE liftA2 #-}
40#endif
41 (*>) = (>>)
42 {-# INLINE (*>) #-}
44instance Monad (ReaderIO e) where
45 ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e
46 {-# INLINE (>>=) #-}
48instance MonadFix (ReaderIO e) where
49 mfix f = ReaderIO $ \e -> mfix $ \r -> runReaderIO (f r) e
50 {-# INLINE mfix #-}
52instance MonadIO (ReaderIO e) where
53 liftIO m = ReaderIO $ \_ -> m
54 {-# INLINE liftIO #-}
56instance MonadReader e (ReaderIO e) where
57 ask = ReaderIO pure
58 {-# INLINE ask #-}
59 local f (ReaderIO m) = ReaderIO (m . f)
60 {-# INLINE local #-}