The following program compiles under GHC 8.0.2 with no language extensions, and produces the expected two lines of output.
However, it does not compile if the (non-top-level) type declaration for the value write' is removed.
Also, I cannot find any (top-level) type declaration for the function write.
I find this rather odd. If this is acceptable standard Haskell, surely it should be possible to create a type declaration for the function write.
So my question is: is there such a type declaration?
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Writer (MonadTrans, Writer, lift, runWriter, tell, when)
import ListT (ListT, toList) -- Volkov's list-t package
logging = True
write x = when logging write' where
write' :: MonadTrans m => m (Writer [String]) ()
write' = lift $ tell [x]
f :: ListT (Writer [String]) String
f = do
write "Hello from f"
return "ABC"
g :: MaybeT (Writer [String]) Int
g = do
write "Hello from g"
return 123
main :: IO ()
main = do
print $ runWriter $ toList f
print $ runWriter $ runMaybeT g
Using GHCi (remember to put this into a separate file and load it on GHCi's command line lest you get confused by GHCi's altered typing rules):
> :t write
write :: (Applicative (m (Writer [String])), MonadTrans m) =>
String -> m (Writer [String]) ()
Why? Well,
write' :: MonadTrans m => m (Writer [String]) ()
when :: Applicative f => Bool -> f () -> f ()
when logging :: Applicative f => f () -> f ()
so, when logging write' must unify write''s m (Writer [String]) with when loggings's f, causing the combined constraint (Applicative (m (Writer [String])), MonadTrans m). But wait, let's remove the type signatures and see what the most general type is:
-- equivalent but slightly easier to talk about
write = when logging . lift . tell . (:[])
(:[]) :: a -> [a]
tell :: MonadWriter w m -> w -> m ()
lift :: (Monad m, MonadTrans t) => m a -> t m a
tell . (:[]) :: MonadWriter [a] m => a -> m ()
lift . tell . (:[]) :: (MonadWriter [a] m, MonadTrans t) => a -> t m ()
when logging . lift . tell . (:[]) = write
:: (Applicative (t m), MonadWriter [a] m, MonadTrans t) => a -> t m ()
-- GHCi agrees
Per se, there's nothing wrong with this type. However, standard Haskell does not allow this. In standard Haskell, a constraint must be of the form C v or C (v t1 t2 ...) where v is a type variable. In the compiling case, this holds: the Applicative constraint has the type variable m on the outside, and the MonadTrans is just m. This is true in the non-compiling version, too, but we also have the constraint MonadWriter ([] a) m. [] is no type variable, so the type here is rejected. This constraint arises in the compiling version, too, but the type signatures nail the variables down to produce MonadWriter [String] (Writer [String]), which is immediately satisfied and does not need to appear in the context of write.
The restriction is lifted by enabling FlexibleContexts (preferably via a {-# LANGUAGE FlexibleContexts #-} pragma, but also maybe by -XFlexibleContexts). It originally existed to prevent things such as the following:
class C a where c :: a -> a
-- no instance C Int
foo :: C Int => Int
foo = c (5 :: Int)
-- with NoFlexibleContexts: foo's definition is in error
-- with FlexibleContexts: foo is fine; all usages of foo are in error for
-- not providing C Int. This might obscure the source of the problem.
-- slightly more insiduous
data Odd a = Odd a
-- no Eq (Odd a)
oddly (Odd 0) (Odd 0) = False
oddly l r = l == r
-- oddly :: (Num a, Eq (Odd a), Eq a) => Odd a -> Odd a -> Bool
-- Now the weird type is inferred! With FlexibleContexts,
-- the weird constraint can propagate quite far, causing errors in distant
-- places. This is confusing. NoFlexibleContexts places oddly in the spotlight.
But it happens to get in the way a lot when you have MultiParamTypeClasses on.
Related
I am trying to get good at Monads and have written the following Monads and functions in which I use the >> (in the apply-function) although it is not declared in the Monad itself. How come this is possible to compile, as I understand http://learnyouahaskell.com/a-fistful-of-monads#walk-the-line it is required to declare it in the instantiation of the Monad as is the case with the Maybe Monad.
data Value =
NoneVal
| TrueVal | FalseVal
| IntVal Int
| StringVal String
| ListVal [Value]
deriving (Eq, Show, Read)
data RunErr = EBadV VName | EBadF FName | EBadA String
deriving (Eq, Show)
newtype CMonad a = CMonad {runCMonad :: Env -> (Either RunErr a, [String]) }
instance Monad CMonad where
return a = CMonad (\_ -> (Right a, []))
m >>= f = CMonad (\env -> case runCMonad m env of
(Left a, strLst) -> (Left a, strLst)
(Right a, strLst) -> let (a', strLst') = runCMonad (f a) env in (a', strLst ++ strLst'))
output :: String -> CMonad ()
output s = CMonad(\env -> (Right (), [] ++ [s]))
apply :: FName -> [Value] -> CMonad Value
apply "print" [] = output "" >> return NoneVal
Furthermore, how would I make it possible to show the output (print it) from the console when running apply. Currently I get the following error message, although my types have derive Show:
<interactive>:77:1: error:
* No instance for (Show (CMonad Value)) arising from a use of `print'
* In a stmt of an interactive GHCi command: print it
The >> operator is optional, not required. The documentation states that the minimal complete definition is >>=. While you can implement both >> and return, you don't have to. If you don't supply them, Haskell can use default implementations that are derived from either >> and/or Applicative's pure.
The type class definition is (current GHC source code, reduced to essentials):
class Applicative m => Monad m where
(>>=) :: forall a b. m a -> (a -> m b) -> m b
(>>) :: forall a b. m a -> m b -> m b
m >> k = m >>= \_ -> k
return :: a -> m a
return = pure
Notice that >>= lacks an implementation, which means that you must supply it. The two other functions have a default implementation, but you can 'override' them if you want to.
If you want to see output from GHCi, the type must be a Show instance. If the type wraps a function, there's no clear way to do that.
The declaration of Monad in the standard Prelude is as follows: (simplified from the Prelude source)
class Applicative m => Monad m where
(>>=) :: forall a b. m a -> (a -> m b) -> m b
(>>) :: forall a b. m a -> m b -> m b
m >> k = m >>= \_ -> k
{-# INLINE (>>) #-}
return :: a -> m a
return = pure
It's a typeclass with three methods, (>>=), (>>) and return.
Of those three, two have a default implementation - the function is implemented in the typeclass, and one does not.
Monad is a subclass of Applicative, and return is the same as pure - it is included in the Monad typeclass (or at all) for historical reasons.
Of the remaining two, (>>=) is all that is needed to define a Monad in Haskell. (>>) could be defined outside of the typeclass, like this:
(>>) :: (Monad m) => forall a b. m a -> m b -> m b
m >> k = m >>= \_ -> k
The reason this is included is in case a monad author wants to override the default implementation with an implementation which is more efficient.
A typeclass method which is not required is know as optional.
Haddock documentation automatically generates a 'Mnimal complete definition' based on the methods without default implementations. You can see here that the minimal definition of Monad is indeed (>>=).
Sometimes, all methods can have default implementations, but they are not optional. This can happen when one of two methods must be provided, and the other is defined in terms of it. This is the case for the Traversable typeclass, where traverse and sequenceA are both implemented in terms of each other. Not implementing either method will cause them to go into an infinite loop.
To let you mark this, GHC provides the MINIMAL pragma, which generates the neccesary compiler warnings, and ensures the Haddocks are correct.
As an aside, failing to implement a required typeclass method is by default a compiler warning, not an error, and will cause a runtime exception if called. There is no good reason for this behaviour.
You can change this default using the -Werror=missing-methods GHC flag.
Happy Haskelling!
So I've been playing around with MonadState class and I have encountered something I consider very strange.
I can try to write a monad like the following:
test ::
( MonadState Int m
, MonadState Bool m
)
=> m ()
test = do
((+1) <$> get) >>= put
(not <$> get) >>= put
If we compile this in ghc 8.6.4 we get the following:
MonadTrans.hs:10:13: error:
• Couldn't match type ‘Int’ with ‘Bool’
arising from a functional dependency between constraints:
‘MonadState Bool m’
arising from a use of ‘get’ at MonadTrans.hs:10:13-15
‘MonadState Int m’
arising from the type signature for:
test :: forall (m :: * -> *).
(MonadState Int m, MonadState Bool m) =>
m ()
at MonadTrans.hs:(4,1)-(8,11)
• In the second argument of ‘(<$>)’, namely ‘get’
In the first argument of ‘(>>=)’, namely ‘((+ 1) <$> get)’
In a stmt of a 'do' block: ((+ 1) <$> get) >>= put
|
10 | ((+1) <$> get) >>= put
|
(older versions of GHC for example 8.2.2 are actually fine with this and compile. I have no idea why.)
Ok this makes sense since the declaration of MonadState has a dependency in it:
class Monad m => MonadState s m | m -> s where
we cannot have a single Monad be both MonadState Int and MonadState Bool. But here is where things get a little strange.
If I add a type annotation the code will compile
test ::
( MonadState Int m
, MonadState Bool m
)
=> m ()
test = do
(((+1) :: Int -> Int) <$> get) >>= put
(not <$> get) >>= put
To me this seems very strange. A moment ago it was complaining about a very real functional dependency conflict between the two. I don't see how disambiguating the type of (+1) makes that conflict go away.
What is happening here? How does the second one compile while the first fails? And why does the first compile on 8.2.2?
Try this:
plus1 :: Int -> Int
plus1 = (+ 1)
test :: (MonadState Int m, MonadState Bool m) => m ()
test = do
(plus1 <$> get) >>= put
(not <$> get) >>= put
Compiles fine, even without the inline type annotation.
What the functor?!
The thing is, when the compiler complains in your first example, it doesn't complain about the type signature just because it decided to verify it for the heck of it. Look a bit further in the error message: ...In the second argument of ‘(<$>)’, namely ‘get’...
Aha! The source of trouble is actually get! But why?
The trouble is the bloody overloaded arithmetic. You see, operator (+) has a polymorphic type, like this:
(+) :: Num a => a -> a -> a
And naked literals also have similar type:
1 :: Num a => a
So when you write (+1), it doesn't let the compiler know that you meant Int. It admits any type a as long as there is Num a.
So the compiler turns to further surroundings to get the type. But wait! Further surroundings are also generic:
get :: MonadState a m => m a
put :: MonadState a m => a -> m ()
Ok, so maybe we can get the type from the signature of test? Let's check that! Oh, no, the signature actually contains a conflict! Bail, bail, bail! That's when you get the error.
All of this doesn't happen on the second line, because not has a non-polymorphic type not :: Bool -> Bool, so the required type of get is known. And this is why either giving an inline type annotation Int -> Int or having it come from an external function plus1 helps on the first line as well.
If you do provide enough type information for the values in the body, the compiler never has to analyze the test signature. The signature specifies that there should be a MonadState Int m dictionary, and that's good enough. Whoever calls the function will have provide the dictionary, and we'll just use that.
Now, of course, when you get around to calling this function, you'll need to provide both dictionaries MonadState Int m and MonadState Bool m, and you can't get those, so you can't actually call such function. But you sure can define it.
That being said, you CAN actually have a monad with two different MonadState instances if you're willing to be sneaky enough about it.
Of course, if you try it straight up, you get a very straight up error:
data M a = M
instance MonadState Int M
instance MonadState Bool M
> Functional dependencies conflict between instance declarations:
> instance MonadState Int M -- Defined at ...
> instance MonadState Bool M -- Defined at ...
Ok, let's start small:
data M a = M
instance MonadState Int M
> Illegal instance declaration for `MonadState a M'
> The liberal coverage condition fails in class `MonadState'
> for functional dependency: `m -> s'
> Reason: lhs type `M' does not determine rhs type `a'
> Un-determined variable: a
Alright, so something in the type of M must indicate the type Int. That makes sense. Let's add it:
data M x a = M a
instance MonadState Int (M Int)
Ok, this works. So far so good.
But of course, in order to define MonadState Bool, I need to add Bool to the type as well:
data M x y a = M a
instance MonadState Int (M Int y)
instance MonadState Bool (M x Bool)
> Functional dependencies conflict between instance declarations:
Ah, still fundep failure! Ok, well, that makes sense too.
So is there a way I can fool the compiler into not checking the instances for the fundep? Yes, there is! I can be sneaky and make the instances overlapped, like this:
instance {-# OVERLAPPABLE #-} (Num a, Show a) => MonadState a (M a y) where
get = M 42
put x = M ()
instance {-# OVERLAPPING #-} MonadState Bool (M x Bool) where
get = M True
put x = M ()
Now all that's left is the Monad instance, and we can have it all actually run:
data M x y a = M a deriving (Functor, Show)
instance Applicative (M x y) where
pure = M
(M f) <*> (M x) = M $ f x
instance Monad (M x y) where
(M x) >>= f = f x
instance {-# OVERLAPPABLE #-} (Num a, Show a) => MonadState a (M a y) where
get = M 42
put x = trace ("Setting Num: " ++ show x) $ M ()
instance {-# OVERLAPPING #-} MonadState Bool (M x Bool) where
get = M True
put x = trace ("Setting Bool: " ++ show x) $ M ()
g :: M Int Bool ()
g = test
main = print g
I've included debug trace to verify how they're actually going to work, so the above program prints:
Setting Num: 43
Setting Bool: False
M ()
So, I'm writing a little helper function to do breadth-first searches (just a hobby project):
import Control.Monad.State
import qualified Data.Set as S
breadthFirst :: (Monad m, Ord a) => (a -> m [a]) -> [a] -> m ()
breadthFirst f init = evalStateT (go init) S.empty
where
go :: [a] -> StateT (S.Set a) m ()
go [] = return ()
go (x:xs) = do
visited <- gets (S.member x)
if visited then (go xs) else do
modify (S.insert x)
lift (f x) >>= (\n -> go (xs++n))
I.e. pull states off a queue, run f to get more states and put them back on the queue, use a Set to keep track of visited states, and whatever side effects m provides.
Except it doesn't compile: Couldn't match type ‘m’ with ‘m1’ etc etc okay the compiler doesn't think the inner a and m are the same as the outer a and m and hence it doesn't think the f x call will compile...
But if I delete the type assertion for go I get Non-type variable argument in the constraint because it infers a too-broad type for go:
go :: forall (t :: (* -> *) -> * -> *).
(MonadTrans t, MonadState (S.Set a) (t m)) =>
[a] -> t m ()
I can fix this with FlexibleContexts but I know the type of go, it's not some arbitrary MonadState instance, it's just StateT. If I replace return () with StateT $ (\s -> ((), s)) then that give the compiler the extra info it needs but that's a little off-putting too.
Is there a way to just tell the compiler the type signature of go, including the fact that the type variables are the same type variables as in the outer function?
Yes, it's done via the ScopedTypeVariables extension. You need to quantify the outer function with forall, then the functions defined in the where clause unless they have forall themselves will refer to the outer scope. When you don't have scoped type variables, every type signature is implicitly quantified so the variables are potentially different to the compiler.
{-# LANGUAGE ScopedTypeVariables #-}
module SO where
import Control.Monad.State
import qualified Data.Set as S
breadthFirst :: forall m a. (Monad m, Ord a) => (a -> m [a]) -> [a] -> m ()
breadthFirst f init = evalStateT (go init) S.empty
where
go :: [a] -> StateT (S.Set a) m ()
go [] = return ()
go (x:xs) = do
visited <- gets (S.member x)
if visited then (go xs) else do
modify (S.insert x)
lift (f x) >>= (\n -> go (xs++n))
I'm learning about mtl and I wish learn the proper way to create new monads as modules (not as typical application usage).
As a simple example I have written a ZipperT monad (complete code here):
{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
module ZipperT (
MonadZipper (..)
, ZipperT
, runZipperT
) where
import Control.Applicative
import Control.Monad.State
class Monad m => MonadZipper a m | m -> a where
pushL :: a -> m ()
pushR :: a -> m ()
...
data ZipperState s = ZipperState { left :: [s], right :: [s] }
newtype ZipperT s m a = ZipperT_ { runZipperT_ :: StateT (ZipperState s) m a }
deriving ( Functor, Applicative
, Monad, MonadIO, MonadTrans
, MonadState (ZipperState s))
instance (Monad m) => MonadZipper s (ZipperT s m) where
pushL x = modify $ \(ZipperState left right) -> ZipperState (x:left) right
pushR x = modify $ \(ZipperState left right) -> ZipperState left (x:right)
...
runZipperT :: (Monad m) => ZipperT s m a -> ([s], [s]) -> m (a, ([s], [s]))
runZipperT computation (left, right) = do
(x, ZipperState left' right') <- runStateT (runZipperT_ computation) (ZipperState left right)
return (x, (left', right'))
it's works and I can compose with other monads
import Control.Monad.Identity
import Control.Monad.State
import ZipperT
length' :: [a] -> Int
length' xs = runIdentity (execStateT (runZipperT contar ([], xs)) 0)
where contar = headR >>= \x -> case x of
Nothing -> return ()
Just _ -> do
right2left
(lift . modify) (+1)
-- ^^^^^^^
contar
But I wish to avoid the explicit lift.
What is the correct way to create modules like this?
Can I avoid the explicit lift? (I wish to hide the internal StateT structure of my ZipperT)
Thank you!
I think that if you can write an instance of MonadState for your transformer you can use modify without the lift:
instance Monad m => MonadState (ZipperT s m a) where
...
I must confess I am not sure about what part of the state modify should affect, though.
I've looked at the complete code. It seems that you already define
MonadState (ZipperState s) (ZipperT s m)
This already provides a modify which however modifies the wrong underlying state. What you actually wanted was to expose the state wrapped in m, provided that is a MonadState itself. This could theoretically be done with
instance MonadState s m => MonadState s (ZipperT s m) where
...
But now we have two MonadState instances for the same monad, causing a conflict.
I think I somehow solved this.
Here's what I did:
First, I removed the original deriving MonadState instance. I instead wrote
getZ :: Monad m => ZipperT s m (ZipperState s)
getZ = ZipperT_ get
putZ :: Monad m => ZipperState s -> ZipperT s m ()
putZ = ZipperT_ . put
modifyZ :: Monad m => (ZipperState s -> ZipperState s) -> ZipperT s m ()
modifyZ = ZipperT_ . modify
and replaced previous occurrences of get,put,modify in the ZipperT library with the above custom functions.
Then I added the new instance:
-- This requires UndecidableInstances
instance MonadState s m => MonadState s (ZipperT a m) where
get = lift get
put = lift . put
And now, the client code works without lifts:
length' :: [a] -> Int
length' xs = runIdentity (execStateT (runZipperT contar ([], xs)) 0)
where contar :: ZipperT a (StateT Int Identity) ()
contar = headR >>= \x -> case x of
Nothing -> return ()
Just _ -> do
right2left
modify (+ (1::Int))
-- ^^^^^^^
contar
Context: This question is specifically in reference to Control.Lens (version 3.9.1 at the time of this writing)
I've been using the lens library and it is very nice to be able to read and write to a piece (or pieces for traversals) of a structure. I then had a though about whether a lens could be used against an external database. Of course, I would then need to execute in the IO Monad. So to generalize:
Question:
Given a getter, (s -> m a) and an setter (b -> s -> m t) where m is a Monad, is possible to construct Lens s t a b where the Functor of the lens is now contained to also be a Monad? Would it still be possible to compose these with (.) with other "purely functional" lenses?
Example:
Could I make Lens (MVar a) (MVar b) a b using readMVar and withMVar?
Alternative:
Is there an equivalent to Control.Lens for containers in the IO monad such as MVar or IORef (or STDIN)?
I've been thinking about this idea for some time, which I'd call mutable lenses. So far, I haven't made it into a package, let me know, if you'd benefit from it.
First let's recall the generalized van Laarhoven Lenses (after some imports we'll need later):
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString as BS
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Traversable (Traversable)
import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.STM
import Control.Concurrent.STM.TVar
type Lens s t a b = forall f . (Functor f) => (a -> f b) -> (s -> f t)
type Lens' s a = Lens s s a a
we can create such a lens from a "getter" and a "setter" as
mkLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
mkLens g s f x = fmap (s x) (f (g x))
and get a "getter"/"setter" from a lens back as
get :: Lens s t a b -> (s -> a)
get l = getConstant . l Constant
set :: Lens s t a b -> (s -> b -> t)
set l x v = runIdentity $ l (const $ Identity v) x
as an example, the following lens accesses the first element of a pair:
_1 :: Lens' (a, b) a
_1 = mkLens fst (\(x, y) x' -> (x', y))
-- or directly: _1 f (a,c) = (\b -> (b,c)) `fmap` f a
Now how a mutable lens should work? Getting some container's content involves a monadic action. And setting a value doesn't change the container, it remains the same, just as a mutable piece of memory does. So the result of a mutable lens will have to be monadic, and instead of the return type container t we'll have just (). Moreover, the Functor constraint isn't enough, since we need to interleave it with monadic computations. Therefore, we'll need Traversable:
type MutableLensM m s a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f ()))
type MutableLensM' m s a
= MutableLensM m s a a
(Traversable is to monadic computations what Functor is to pure computations).
Again, we create helper functions
mkLensM :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM m s a b
mkLensM g s f x = g x >>= T.mapM (s x) . f
mget :: (Monad m) => MutableLensM m s a b -> s -> m a
mget l s = liftM getConstant $ l Constant s
mset :: (Monad m) => MutableLensM m s a b -> s -> b -> m ()
mset l s v = liftM runIdentity $ l (const $ Identity v) s
As an example, let's create a mutable lens from a TVar within STM:
alterTVar :: MutableLensM' STM (TVar a) a
alterTVar = mkLensM readTVar writeTVar
These lenses are one-sidedly directly composable with Lens, for example
alterTVar . _1 :: MutableLensM' STM (TVar (a, b)) a
Notes:
Mutable lenses could be made more powerful if we allow that the modifying function to include effects:
type MutableLensM2 m s a b
= (Traversable f) => (a -> m (f b)) -> (s -> m (f ()))
type MutableLensM2' m s a
= MutableLensM2 m s a a
mkLensM2 :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM2 m s a b
mkLensM2 g s f x = g x >>= f >>= T.mapM (s x)
However, it has two major drawbacks:
It isn't composable with pure Lens.
Since the inner action is arbitrary, it allows you to shoot yourself in the foot by mutating this (or other) lens during the mutating operation itself.
There are other possibilities for monadic lenses. For example, we can create a monadic copy-on-write lens that preserves the original container (just as Lens does), but where the operation involves some monadic action:
type LensCOW m s t a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f t))
I've made jLens - a Java library for mutable lenses, but the API is of course far from being as nice as Haskell lenses.
No, you can not constrain the "Functor of the lens" to also be a Monad. The type for a Lens requires that it be compatible with all Functors:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
This reads in English something like: A Lens is a function, which, for all types f where f is a Functor, takes an (a -> f b) and returns an s -> f t. The key part of that is that it must provide such a function for every Functor f, not just some subset of them that happen to be Monads.
Edit:
You could make a Lens (MVar a) (MVar b) a b, since none of s t a, or b are constrained. What would the types on the getter and setter needed to construct it be then? The type of the getter would be (MVar a -> a), which I believe could only be implemented as \_ -> undefined, since there's nothing that extracts the value from an MVar except as IO a. The setter would be (MVar a -> b -> MVar b), which we also can't define since there's nothing that makes an MVar except as IO (MVar b).
This suggests that instead we could instead make the type Lens (MVar a) (IO (MVar b)) (IO a) b. This would be an interesting avenue to pursue further with some actual code and a compiler, which I don't have right now. To combine that with other "purely functional" lenses, we'd probably want some sort of lift to lift the lens into a monad, something like liftLM :: (Monad m) => Lens s t a b -> Lens s (m t) (m a) b.
Code that compiles (2nd edit):
In order to be able to use the Lens s t a b as a Getter s a we must have s ~ t and a ~ b. This limits our type of useful lenses lifted over some Monad to the widest type for s and t and the widest type for a and b. If we substitute b ~ a into out possible type we would have Lens (MVar a) (IO (MVar a)) (IO a) a, but we still need MVar a ~ IO (MVar a) and IO a ~ a. We take the wides of each of these types, and choose Lens (IO (MVar a)) (IO (MVar a)) (IO a) (IO a), which Control.Lens.Lens lets us write as Lens' (IO (MVar a)) (IO a). Following this line of reasoning, we can make a complete system for combining "purely functional" lenses with lenses on monadic values. The operation to lift a "purely function" lens, liftLensM, then has the type (Monad m) => Lens' s a -> LensF' m s a, where LensF' f s a ~ Lens' (f s) (f a).
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Main (
main
) where
import Control.Lens
import Control.Concurrent.MVar
main = do
-- Using MVar
putStrLn "Ordinary MVar"
var <- newMVar 1
output var
swapMVar var 2
output var
-- Using mvarLens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO"
value <- (return var) ^. mvarLens
putStrLn $ show value
set mvarLens (return 3) (return var)
output var
-- Debugging lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs"
value <- readM (debug mvarLens) var
putStrLn $ show value
setM (debug mvarLens) 4 var
output var
-- Debugging crazy box lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs"
value <- readM ((debug mvarLens) . (debug (liftLensM boxLens))) var
putStrLn $ show value
setM ((debug mvarLens) . (debug (liftLensM boxLens))) (Box 5) var
output var
where
output = \v -> (readMVar v) >>= (putStrLn . show)
-- Types to write higher lenses easily
type LensF f s t a b = Lens (f s) (f t) (f a) (f b)
type LensF' f s a = Lens' (f s) (f a)
type GetterF f s a = Getter (f s) (f a)
type SetterF f s t a b = Setter (f s) (f t) (f a) (f b)
-- Lenses for MVars
setMVar :: IO (MVar a) -> IO a -> IO (MVar a)
setMVar ioVar ioValue = do
var <- ioVar
value <- ioValue
swapMVar var value
return var
getMVar :: IO (MVar a) -> IO a
getMVar ioVar = do
var <- ioVar
readMVar var
-- (flip (>>=)) readMVar
mvarLens :: LensF' IO (MVar a) a
mvarLens = lens getMVar setMVar
-- Lift a Lens' to a Lens' on monadic values
liftLensM :: (Monad m) => Lens' s a -> LensF' m s a
liftLensM pureLens = lens getM setM
where
getM mS = do
s <- mS
return (s^.pureLens)
setM mS mValue = do
s <- mS
value <- mValue
return (set pureLens value s)
-- Output when a Lens' is used in IO
debug :: (Show a) => LensF' IO s a -> LensF' IO s a
debug l = lens debugGet debugSet
where
debugGet ioS = do
value <- ioS^.l
putStrLn $ show $ "Getting " ++ (show value)
return value
debugSet ioS ioValue = do
value <- ioValue
putStrLn $ show $ "Setting " ++ (show value)
set l (return value) ioS
-- Easier way to use lenses in a monad (if you don't like writing return for each argument)
readM :: (Monad m) => GetterF m s a -> s -> m a
readM l s = (return s) ^. l
setM :: (Monad m) => SetterF m s t a b -> b -> s -> m t
setM l b s = set l (return b) (return s)
-- Another example lens
newtype Boxed a = Box {
unBox :: a
} deriving Show
boxLens :: Lens' a (Boxed a)
boxLens = lens Box (\_ -> unBox)
This code produces the following output:
Ordinary MVar
1
2
MVar accessed through a LensF' IO
2
3
MVar accessed through a LensF' IO that also debugs
"Getting 3"
3
"Setting 4"
4
MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs
"Getting 4"
"Getting Box {unBox = 4}"
Box {unBox = 4}
"Setting Box {unBox = 5}"
"Getting 4"
"Setting 5"
5
There's probably a better way to write liftLensM without resorting to using lens, (^.), set and do notation. Something seems wrong about building lenses by extracting the getter and setter and calling lens on a new getter and setter.
I wasn't able to figure out how to reuse a lens as both a getter and a setter. readM (debug mvarLens) and setM (debug mvarLens) both work just fine, but any construct like 'let debugMVarLens = debug mvarLens' loses either the fact it works as a Getter, the fact it works as a Setter, or the knowledge that Int is an instance of show so it can me used for debug. I'd love to see a better way of writing this part.
I had the same problem. I tried the methods in Petr and Cirdec's answers but never got to the point I wanted to. Started working on the problem, and at the end, I published the references library on hackage with a generalization of lenses.
I followed the idea of the yall library to parameterize the references with monad types. As a result there is an mvar reference in Control.Reference.Predefined. It is an IO reference, so an access to the referenced value is done in an IO action.
There are also other applications of this library, it is not restricted to IO. An additional feature is to add references (so adding _1 and _2 tuple accessors will give a both traversal, that accesses both fields). It can also be used to release resources after accessing them, so it can be used to manipulate files safely.
The usage is like this:
test =
do result <- newEmptyMVar
terminator <- newEmptyMVar
forkIO $ (result ^? mvar) >>= print >> (mvar .= ()) terminator >> return ()
hello <- newMVar (Just "World")
forkIO $ ((mvar & just & _tail & _tail) %~= ('_':) $ hello) >> return ()
forkIO $ ((mvar & just & element 1) .= 'u' $ hello) >> return ()
forkIO $ ((mvar & just) %~= ("Hello" ++) $ hello) >> return ()
x <- runMaybeT $ hello ^? (mvar & just)
mvar .= x $ result
terminator ^? mvar
The operator & combines lenses, ^? is generalized to handle references of any monad, not just a referenced value that may not exist. The %~= operator is an update of a monadic reference with a pure function.