module Main (main) where
import Control.Monad.Reader
p1 :: String -> IO ()
p1 = putStrLn . ("Apple "++)
p2 :: String -> IO ()
p2 = putStrLn . ("Pear "++)
main :: IO ()
main = do
p1 "x"
p2 "y"
r "z"
r :: String -> IO ()
r = do
p1
p2
It prints:
Apple x
Pear y
Pear z
Why?
The problem is in r. Given the following definition of Reader monad:
instance Monad ((->) e) where
return = const
f >>= g = \x -> g (f x) x
We can simplify r:
r = p1 >> p2
= (>>=) p1 (\_ -> p2)
= (\f g x -> g (f x) x) p1 (\_ -> p2)
= \x -> (\_ -> p2) (p1 x) x
= \x -> p2 x
This also shows that Reader's (>>) is just const with a bit more specific type.
If you want to distribute the environment and then execute both actions, you have to bind the result of applying p1 to the environment, for example:
r = do a1 <- p1
a2 <- p2
return (a1 >> a2)
Or using Applicative:
r = (>>) <$> p1 <*> p2
Expanding on the Reader part, Control.Monad.Reader provides three variants of Reader.
the implicit (->) e, which is what the function r uses
the monad transformer ReaderT e m, a newtype wrapper for functions of type e -> m a
the explicit Reader e, defined in terms of ReaderT as ReaderT e Identity
Without any further information, the implicit (->) e will be used. Why?
The overall type of do block is given by the last expression, which is also constrained to be of the form Monad m => m a for some m and a.
Looking back at r, it's clear that the do block has a type String -> IO () as given by the type of r and also p2. It also requires String -> IO () to be Monad m => m a. Now, unifying these two types:
m = (->) String
a = IO ()
This matches (->) e monad instance by choosing e = String.
Being a monad transformer, ReaderT takes care of the inner plumbing to make sure the actions of the inner monad are properly sequenced and executed. To select ReaderT, it is necessary to explicitly mention it (usually in a type signature, but functions which fix the type to be ReaderT, such as runReaderT, also work):
r :: ReaderT String IO ()
r = do ? p1
? p2
r' :: String -> IO ()
r' = runReaderT r
This comes with another problem, p1 and p2 have a type String -> IO (), which doesn't match the required ReaderT String IO ().
The ad-hoc solution (tailored exactly for this situation), is just to apply
ReaderT :: (e -> m a) -> ReaderT e m a
To obtain something more general, MonadIO type class can lift IO actions into the transformer and MonadReader type class allows accessing the environment. These two type classes work as long as there is IO (or ReaderT respectively) somewhere in the transformer stack.
lift' :: (MonadIO m, MonadReader a m) => (a -> IO b) -> m b
lift' f = do
env <- ask -- get environment
let io = f env -- apply f to get the IO action
liftIO io -- lift IO action into transformer stack
Or more concisely:
lift' f = ask >>= liftIO . f
Regarding your question in comments, you can implement the relevant instances in this way:
newtype ReaderT e m a = ReaderT { runReaderT :: e -> m a }
instance Monad m => Monad (ReaderT e m) where
return = ReaderT . const . return
-- The transformers package defines it as "lift . return".
-- These two definitions are equivalent, though.
m >>= f = ReaderT $ \e -> do
a <- runReaderT m e
runReaderT (f a) e
instance Monad m => MonadReader e (ReaderT e m) where
ask = ReaderT return
local f m = ReaderT $ runReaderT m . f
reader f = ReaderT (return . f)
The actual typeclass can be found in the mtl package (package, type class), the newtype and Monad instance in transformers package (package, type class).
As for making a e -> m a Monad instance, you are out of luck. Monad requires a type constructor of kind * -> *, which means we are attempting to do something like this (in pseudo-code):
instance Monad m => Monad (/\a -> e -> m a) where
-- ...
where /\ stands for type-level lambda. However, the closest thing we can get to a type level lambda is a type synonym (which must be fully applied before we can make type class instances, so no luck here) or a type family (which cannot be used as an argument to type class either). Using something like (->) e . m leads to newtype again.
Let's first rewrite the body of
r :: String -> IO ()
r = do
p1
p2
using (>>),
r = p1 >> p2
so p1 must have type m a for some Monad m, and p2 must have type m b for the same m.
Now,
p1, p2 :: String -> IO ()
and the top-level type constructor in that is the function arrow (->). Therefore the Monad used in r must be
(->) String
The Monad instance for (->) e [aka the reader monad], is
instance Monad ((->) e) where
-- return :: a -> (e -> a)
return = const
-- (>>=) :: (e -> a) -> (a -> (e -> b)) -> (e -> b)
f >>= g = \x -> g (f x) x
and consequently,
p1 >> p2 = p1 >>= \_ -> p2
= \x -> (\_ -> p2) (p1 x) x -- apply (\_ -> p2) to (p1 x)
= \x -> p2 x -- eta-reduce
= p2
so that was just a complicated way to write
r = p2
For r you used (->) String (IO ()) which is a Monad ((->) String) that returns a value of type IO ().
You did NOT use a ReaderT or any monad transformer. You used a monad that returns a different monad. It accidentally compiled and ran, almost doing what you expected.
You need to use runReaderT and lift (or liftIO) to achieve the r that I think you are trying to make.
You left off the argument when you invoke p1 and p2 in r. What you wrote is then interpreted as pointfree notation, so only the second IO action gets an argument. This works:
r :: String -> IO ()
r x = do
p1 x
p2 x
To understand why this is happening, consider that what you originally wrote is equivalent to
r = p1 >> p2
The compiler interprets that as something like
r x = (p1 >> p2) x
Which isn't what you want.
Related
I'd like to use literal haskell functions in a dsl as follows:
program :: forall m . DSL m => m ()
program = do
stm $ Stm (Var "a")
-- this way:
f <- fun $ \(a :: Expr a) (b :: Expr b) -> do
-- function body is of the same monad `m` as the one in top level
stm $ Stm (Var "b")
stm $ Stm $ Apply f (Var "c")
pure ()
.. and turn the above into code ([Stm]).
To make the functions work there is a helper class Fun (code below)
that saturates the function with fresh variables until it reaches
function body,
then returns both the list of arguments and body itself so that they
could be made into function syntax[1]. There is a recursive case to
generate arguments[2] and a base case to evaluate body to [Stm].[3]
The worrisome instance is the base case[4], which currently requires
{-# INCOHERENT #-}, because ghc can't choose a Fun instance because
function's body in the program is ambiguous (while it should just be
whatever m is at top level code).
So the question is:
is there a way to force the body to always use the
same m as in top level and not require incoherent instances?
A stub AST, the MTL-style DSL "effect" and a sample instance of the class:
-- | An AST
data Expr a
= Var String
| Apply String (Expr a)
| Function String [String] [Stm]
data Stm = Stm (Expr ())
-- | The "effect"
class Monad m => DSL m where
freshName :: m String -- generate fresh variable name
stm :: Stm -> m () -- emit statement
toAST :: m a -> m [Stm] -- turn code `m a` into [Stm] (without emitting it)
fun :: Fun f m => f -> m String -- emit function f, return its name
-- | Helper class to convert literal haskell functions to the dsl
class Fun f m where
mkFun :: DSL m => f -> [String] -> m ([String], [Stm])
instance Fun f m => Fun (Expr a -> f) m where
mkFun f acc = do
name <- freshName -- [2]
mkFun (f $ Var name) (name : acc)
instance {-# INCOHERENT #-} (m0 ~ m) => Fun (m0 a) m where -- [4]
mkFun m args = do
fname <- freshName
body <- toAST m -- [3]
return (args, body)
-- | A sample implementation
instance DSL (StateT Int (Writer [Stm])) where
freshName = do
n <- get
put $ n + 1
return $ "var" <> show n
stm stm' = tell [stm']
toAST m = do
state0 <- get
let ((_, state1), w) = run m state0
put state1
return w
fun f = do
(args, body) <- mkFun f []
name <- freshName
stm $ Stm $ Function name args body -- [1]
return name
run :: StateT Int (Writer [Stm]) a -> Int -> ((a, Int), [Stm])
run m s = runWriter $ runStateT m s
I guess one way is to mark the base case of the recursion yourself.
newtype Cook m a = Cook (m a)
deriving instance DSL m => DSL (Cook m)
instance Fun f m => Fun (Expr a -> f) m
instance m0 ~ m => Fun (Cook m0 a) (Cook m)
type SampleImplRaw = StateT Int (Writer [Stm])
type SampleImpl = Cook SampleImplRaw
instance DSL SampleImpl
I haven't typed this into the compiler, so I'm not sure, but it may be that you get into a funny situation where you want a DSL m instance, and have a DSL (Cook m) instance in scope, but the compiler can't figure out how to get from A to B. In such a case it should be possible to coerce the offending term to use the Cook m instance.
Another way might be to try making the base case have a different kind. Something like this:
instance Fun f m => Fun (Expr a -> f) m
instance (m ~ m', p ~ p', p ~ '()) => Fun (m p a) (m' p')
data SampleImplRaw (x :: ()) a = {- whatever you would have written before for new data declarations -}
type SampleImpl = SampleImplRaw '()
newtype Const1 (x :: ()) m a = Const1 (m a) deriving (EVERYTHING) -- still need a cook for mere monad transformer stacks
I guess probably if your plan is mostly to use transformer stacks, the first one will be less roundabout; if your plan is mostly to define new data types, the second will have a cleaner user experience.
Could you help what parameter is getting by ask ?
We often can see ask >>= f
It means that ask >>= f = (\k -> f (ask k) k)
So ask must be able to get k, function from enviroment.
However, in docs it is written: ask :: m r.
Where am I wrong ?
It's the Reader monad. Ultimately the best answer is just to study its implementation, which in it simplest version (no monad transformers, no classes) can be defined like this:
newtype Reader r a = Reader { runReader :: r -> a }
This is a newtype declaration, so Reader r a is just a "relabeling" (so to speak) of the function type r -> a. ask is defined like this:
ask :: Reader r r
ask = Reader (\r -> r)
Which means that ask is a relabeled identity function—the function that just returns its own argument. We can see this if we use the runReader operation to feed values to it :
ghci> runReader ask 5
5
ghci> runReader ask "Hello world!"
"Hello world!"
That doesn't look very useful, but the magic comes from the fact that Reader has instances for Functor, Applicative and Monad:
instance Functor (Reader r) where
fmap f (Reader g) =
-- A `Reader` that applies `f` to the original `Reader`'s results
Reader (\r -> f (g r))
instance Applicative (Reader r) where
pure a =
-- A `Reader` that ignores its `r` argument and just produces
-- a fixed value.
Reader (\_ -> a)
Reader ff <*> Reader fa =
-- A `Reader` that "combines" two `Reader`s by feeding the same
-- `r` value to both, and then combining their results
Reader (\r -> ff r (fa r))
instance Monad (Reader r) where
return = pure
Reader fa >>= k =
-- A `Reader` that feeds the same `r` both to the original one
-- and to the one computed by the `k` function
Reader (\r -> k (fa r) r)
If you study these, you'll notice that what Reader is about is delaying the point of the program where you apply the wrapper r -> a function to an r. Normally, if you have a function of type r -> a and you want to get a value of type a, you have to feed the function an argument of type r. The Reader class instances allow you instead to supply functions that will be used to operate on the a ahead of time, and then supply the r in the end.
The ReaderT type and the MonadReader class (which has the ask :: MonadReader r m => m r method) are just more advanced versions of this.
A value of type m a where m is a Monad, can be thought of as a "monadic action". So ask doesn't take any parameters, it's just a value that you can bind (>>=) to extract some value from a Reader monad.
Look at the definition of ask for ReaderT in Control.Monad.Trans.Reader:
-- | Fetch the value of the environment.
ask :: (Monad m) => ReaderT r m r
ask = ReaderT return
ReaderT is just a data constructor that contains a value of type r -> m a, so ReaderT return is a value of type ReaderT r m r that contains a function, return (of the monad m).
In other words, ask here is a "monadic action" that extracts the value of stored inside the Reader.
ask >>= f
Which is
(ReaderT return) >>= f
Using definition of >>= for Reader, we get:
ReaderT $ \ r -> do
a <- runReaderT (ReaderT return) r
runReaderT (f a) r
Which reduces to
ReaderT $ \ r -> do
a <- return r
runReaderT (f a) r
Or
ReaderT $ \r -> runReaderT (f r) r
So, it passes the stored value along to decide the next action and also passes the value so the next actions can read it as it was before.
(If this wasn't clear, look for a Reader tutorial maybe)
How can we prove that the continuation monad has no valid instance of MonadFix?
Well actually, it's not that there can't be a MonadFix instance, just that the library's type is a bit too constrained. If you define ContT over all possible rs, then not only does MonadFix become possible, but all instances up to Monad require nothing of the underlying functor :
newtype ContT m a = ContT { runContT :: forall r. (a -> m r) -> m r }
instance Functor (ContT m) where
fmap f (ContT k) = ContT (\kb -> k (kb . f))
instance Monad (ContT m) where
return a = ContT ($a)
join (ContT kk) = ContT (\ka -> kk (\(ContT k) -> k ka))
instance MonadFix m => MonadFix (ContT m) where
mfix f = ContT (\ka -> mfixing (\a -> runContT (f a) ka<&>(,a)))
where mfixing f = fst <$> mfix (\ ~(_,a) -> f a )
Consider the type signature of mfix for the continuation monad.
(a -> ContT r m a) -> ContT r m a
-- expand the newtype
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
Here's the proof that there's no pure inhabitant of this type.
---------------------------------------------
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
introduce f, k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
a
dead end, backtrack
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply f
f :: a -> (a -> m r) -> m r f :: a -> (a -> m r) -> m r
k :: a -> m r k :: a -> m r
--------------------------- ---------------------------
a a -> m r
dead end reflexivity k
As you can see the problem is that both f and k expect a value of type a as an input. However, there's no way to conjure a value of type a. Hence, there's no pure inhabitant of mfix for the continuation monad.
Note that you can't define mfix recursively either because mfix f k = mfix ? ? would lead to an infinite regress since there's no base case. And, we can't define mfix f k = f ? ? or mfix f k = k ? because even with recursion there's no way to conjure a value of type a.
But, could we have an impure implementation of mfix for the continuation monad? Consider the following.
import Control.Concurrent.MVar
import Control.Monad.Cont
import Control.Monad.Fix
import System.IO.Unsafe
instance MonadFix (ContT r m) where
mfix f = ContT $ \k -> unsafePerformIO $ do
m <- newEmptyMVar
x <- unsafeInterleaveIO (readMVar m)
return . runContT (f x) $ \x' -> unsafePerformIO $ do
putMVar m x'
return (k x')
The question that arises is how to apply f to x'. Normally, we'd do this using a recursive let expression, i.e. let x' = f x'. However, x' is not the return value of f. Instead, the continuation given to f is applied to x'. To solve this conundrum, we create an empty mutable variable m, lazily read its value x, and apply f to x. It's safe to do so because f must not be strict in its argument. When f eventually calls the continuation given to it, we store the result x' in m and apply the continuation k to x'. Thus, when we finally evaluate x we get the result x'.
The above implementation of mfix for the continuation monad looks a lot like the implementation of mfix for the IO monad.
import Control.Concurrent.MVar
import Control.Monad.Fix
instance MonadFix IO where
mfix f = do
m <- newEmptyMVar
x <- unsafeInterleaveIO (takeMVar m)
x' <- f x
putMVar m x'
return x'
Note, that in the implementation of mfix for the continuation monad we used readMVar whereas in the implementation of mfix for the IO monad we used takeMVar. This is because, the continuation given to f can be called multiple times. However, we only want to store the result given to the first callback. Using readMVar instead of takeMVar ensures that the mutable variable remains full. Hence, if the continuation is called more than once then the second callback will block indefinitely on the putMVar operation.
However, only storing the result of the first callback seems kind of arbitrary. So, here's an implementation of mfix for the continuation monad that allows the provided continuation to be called multiple times. I wrote it in JavaScript because I couldn't get it to play nicely with laziness in Haskell.
// mfix :: (Thunk a -> ContT r m a) -> ContT r m a
const mfix = f => k => {
const ys = [];
return (function iteration(n) {
let i = 0, x;
return f(() => {
if (i > n) return x;
throw new ReferenceError("x is not defined");
})(y => {
const j = i++;
if (j === n) {
ys[j] = k(x = y);
iteration(i);
}
return ys[j];
});
}(0));
};
const example = triple => k => [
{ a: () => 1, b: () => 2, c: () => triple().a() + triple().b() },
{ a: () => 2, b: () => triple().c() - triple().a(), c: () => 5 },
{ a: () => triple().c() - triple().b(), b: () => 5, c: () => 8 },
].flatMap(k);
const result = mfix(example)(({ a, b, c }) => [{ a: a(), b: b(), c: c() }]);
console.log(result);
Here's the equivalent Haskell code, sans the implementation of mfix.
import Control.Monad.Cont
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> ContT r [] Triple
example triple = ContT $ \k ->
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
] >>= k
result :: [Triple]
result = runContT (mfix example) pure
main :: IO ()
main = print result
Notice that this looks a lot like the list monad.
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> [Triple]
example triple =
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
]
result :: [Triple]
result = mfix example
main :: IO ()
main = print result
This makes sense because after all the continuation monad is the mother of all monads. I'll leave the verification of the MonadFix laws of my JavaScript implementation of mfix as an exercise for the reader.
I have a function which is something like myFunction below:
data MyError = E1 | E2
f s = if s == "" then Left E1 else Right $ reverse s
g = (fmap reverse) . f
myFunction :: String -> Either MyError (String, String)
myFunction s = do
s1 <- f s
s2 <- g s1
return (s2, s2)
So it calls various other functions which are also in the Either monad, so everything is OK.
Now I have a situation where the type of one of the functions, say g, changes to
g :: CPRG r => r -> String -> (Either MyError String, r)
For reference, the "real-world" code is the decode function here and the function that changes is Jwe.rsaDecode (I'm adding RSA blinding to the decryption function).
As a result, myFunction needs to have the same type, so that I can pass in the CPRG and return it. I'm having trouble seeing how I can carry on using something like the Either monad in combination with passing the RNG, and still be able to extract the final state of the RNG in both the failure and success cases, so that it can be returned.
The type
r -> (Either e a, r)
is a monad transformer. In particular, it's the ExceptT transformer
newtype ExceptT e m a = ExceptT (m (Either e a))
We'll specialize it for State such that
r -> (Either e a, r)
~
ExceptT e (State r) a
So what is a monad transformer? Well, it turns out that often when you take two monads together and stack them you end up with yet another monad. It is not always the case and is a bit tricky to do in general (unlike Applicative where stacks of Applicative functors are always yet again Applicative functors).
That said, the library linked above, mtl, demonstrates a list of common "transformers" which encode common ways of stacking monads. Thus, ExceptT is one of these "recipes" and it is designed such that ExceptT e m a is a monad so long as m is also a Monad.
So now we can create a new type alias
type M r a = ExceptT MyError (State r) a
and write g as a function like
g' :: CPRG r => String -> M r String
g' s = do
r <- lift get -- lift "lifts" State monad computations up
let (e, r') = g r s
lift $ put r'
either throwError return e -- here we generalize an Either
-- into the M monad.
One irritation with lazy IO caught to my attention recently
import System.IO
import Control.Applicative
main = withFile "test.txt" ReadMode getLines >>= mapM_ putStrLn
where getLines h = lines <$> hGetContents h
Due to lazy IO, the above program prints nothing. So I imagined this could be solved with a strict version of fmap. And indeed, I did come up with just such a combinator:
forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v
(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)
Replacing <$> with <$!> does indeed alleviate the problem. However, I am not satisfied. <$!> has a Monad constraint, which feels too tight; it's companion <$> requires only Functor.
Is there a way to write <$!> without the Monad constraint? If so, how? If not, why not? I've tried throwing strictness all over the place, to no avail (following code does not work as desired):
forceF :: Functor f => f a -> f a
forceF m = fmap (\x -> seq x x) $! m
(<$!>) :: Functor f => (a -> b) -> f a -> f b
f <$!> m = fmap (f $!) $! (forceF $! m)
I don't think it's possible, and also the monadic forceM doesn't work for all monads:
module Force where
import Control.Monad.State.Lazy
forceM :: Monad m => m a -> m a
forceM m = do v <- m; return $! v
(<$!>) :: Monad m => (a -> b) -> m a -> m b
f <$!> m = liftM f (forceM m)
test :: Int
test = evalState (const 1 <$!> undefined) True
And the evaluation:
Prelude Force> test
1
forceM needs a strict enough (>>=) to actually force the result of its argument. Functor doesn't even have a (>>=). I don't see how one could write an effective forceF. (That doesn't prove it's impossible, of course.)