I'm baffled by this compiler error message I'm getting. The functions addAgent and withAgent have similar type signatures and similar implementations, so I don't understand why addAgent compiles but withAgent doesn't. Thank you in advance for any help!
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (StateT, execStateT, gets, modify)
class AgentDatabase d where
type Elem d
addAgent :: Elem d -> StateT d IO ()
withAgent ::
(Elem d -> StateT d IO (Elem d)) -> String -> StateT d IO ()
data SimpleUniverse d = SimpleUniverse {
agentDB :: d
-- plus other fields
}
-- I want the methods of class AgentDatabase to "penetrate" through
-- the outer wrapper of SimpleUniverse and operate on the agentDB field.
instance (AgentDatabase d) =>
AgentDatabase (SimpleUniverse d) where
type Elem (SimpleUniverse d) = Elem d
-- When addAgent is invoked on a SimpleUniverse, apply it to the
-- agentDB field inside.
addAgent a = do
db <- gets agentDB
db' <- liftIO $ execStateT (addAgent a) db
modify (\u -> u { agentDB=db' } )
-- When withAgent is invoked on a SimpleUniverse, apply it to the
-- agentDB field inside.
withAgent program name = do
db <- gets agentDB
db' <- liftIO $ execStateT (withAgent program name) db -- line 33
modify (\u -> u { agentDB=db' } )
The error message I get is...
amy3.hs:33:11:
Couldn't match type `d' with `SimpleUniverse d'
`d' is a rigid type variable bound by
the instance declaration at amy3.hs:19:25
When using functional dependencies to combine
Control.Monad.State.Class.MonadState s (StateT s m),
arising from the dependency `m -> s'
in the instance declaration in `Control.Monad.State.Class'
Control.Monad.State.Class.MonadState
(SimpleUniverse (SimpleUniverse d)) (StateT (SimpleUniverse d) IO),
arising from a use of `gets' at amy3.hs:33:11-14
In a stmt of a 'do' block: db <- gets agentDB
In the expression:
do { db <- gets agentDB;
db' <- liftIO $ execStateT (withAgent program name) db;
modify (\ u -> u {agentDB = db'}) }
Failed, modules loaded: none.
program has type
Elem (SimpleUniverse d) -> StateT (SimpleUniverse d) IO (Elem (SimpleUniverse d))
which indeed simplifies, but to
Elem d -> StateT (SimpleUniverse d) IO (Elem d)
and the inner withAgent takes a program of type
Elem d -> StateT d IO (Elem d)
To fix that, this function will help:
stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g
Related
I am trying to pass a function in a Reader that is to be called from the same monad as the calling function, but I get an infinite type error.
The simplified code is:
{-# LANGUAGE FlexibleContexts #-}
module G2 where
import Control.Monad
import Control.Monad.Reader
data Foo m = Foo { bar :: m () }
runFoo :: MonadReader (Foo m) m => m ()
runFoo = do
b <- asks bar
b
main :: Monad m => m ()
main = do
let bar = return () :: m ()
foo = Foo bar
runReaderT runFoo foo
And the error is:
• Occurs check: cannot construct the infinite type:
m0 ~ ReaderT (Foo m0) m
arising from a functional dependency between:
constraint ‘MonadReader
(Foo (ReaderT (Foo m0) m)) (ReaderT (Foo m0) m)’
arising from a use of ‘runFoo’
instance ‘MonadReader r (ReaderT r m1)’ at <no location info>
• In the first argument of ‘runReaderT’, namely ‘runFoo’
In a stmt of a 'do' block: runReaderT runFoo foo
In the expression:
do let bar = ...
foo = Foo bar
runReaderT runFoo foo
• Relevant bindings include main :: m () (bound at G2.hs:16:1)
|
19 | runReaderT runFoo foo
| ^^
Any help would be much appreciated, thanks!
runFoo :: MonadReader (Foo m) m => m ()
Let's forget about the class, and just assume that MonadReader env mon means that mon ~ ((->) env). This corresponds to simply using (->) as our monad instead of the fancier ReaderT. Then you get m ~ ((->) m) => m (). You see that m needs to contain itself (specifically, the argument to m is m). This is OK for values, but it would be quite bad if the typechecker had to deal with infinitely large types. The same is true for ReaderT (and you need to use ReaderT because you call runReaderT runFoo). You need to define another newtype to encode this recursion:
data RecReader c a = RecReader { runRecReader :: c (RecReader c) -> a }
instance Functor (RecReader c) where
fmap f (RecReader r) = RecReader $ f . r
instance Applicative (RecReader c) where
pure = RecReader . const
RecReader f <*> RecReader g = RecReader $ \e -> f e (g e)
instance Monad (RecReader c) where
return = pure
RecReader x >>= f = RecReader $ \e -> runRecReader (f (x e)) e
instance MonadReader (c (RecReader c)) (RecReader c) where
ask = RecReader id
local f (RecReader x) = RecReader $ x . f
And it works:
runRecReader runFoo (Foo $ return ())
-- ==>
()
I have a type family of variadic functions:
type family (~~>) (argTypes :: [Type]) (result :: Type) :: Type where
'[] ~~> r = r
(t ': ts) ~~> r = t -> (ts ~~> r)
infixr 0 ~~>
I want a variadic function which applies some monadic action (say print) to all its arguments:
class Foo (ts :: [Type]) where
foo :: ts ~~> IO ()
instance Foo '[] where
foo = pure ()
instance (Show t, Foo ts) => Foo (t ': ts) where
foo t = print t >> foo #ts
Usual monadic composition doesn't work here.
(>>) has type IO () -> IO () -> IO (). I need to use something of type IO () -> (ts ~~> IO ()) -> ts ~~> IO () to compose print t and foo #ts there.
Is it possible to write such function at all?
Continuation passing style gives direct access to the result of a computation.
Another way would be to build a type class to iterate composition, but it's cumbersome.
{-# LANGUAGE FlexibleInstances #-}
class Foo t where
foo_ :: (IO () -> IO ()) -> t
instance (Show a, Foo t) => Foo (a -> t) where
foo_ k a = foo_ (\continue -> k (print a >> continue))
instance Foo (IO ()) where
foo_ k = k (return ())
foo :: Foo t => t
foo = foo_ id
main :: IO ()
main = foo () (Just "bar") [()]
I found a way to write function IO () -> (ts ~~> IO ()) -> ts ~~> IO ()
-- | Perform first action `m a` then pass its result to a function `(a -> ts ~~> mb)`
-- which returns variadic function and return that function.
class BindV (m :: Type -> Type) a b (ts :: [Type]) where
bindV :: m a -> (a -> ts ~~> m b) -> ts ~~> m b
instance (Monad m) => BindV m a b '[] where
bindV ma f = ma >>= f
instance (BindV m a b ts) => BindV m a b (t ': ts) where
bindV ma f x = bindV #m #a #b #ts ma ((flip f) x)
-- | Monadic composition that discards result of the first action.
thenV :: forall (m :: Type -> Type) a b (ts :: [Type]).
(BindV m a b ts) =>
m a -> (ts ~~> m b) -> ts ~~> m b
thenV ma f = bindV #m #a #b #ts ma (\_ -> f)
Thus instance in question become:
instance (Show t, Foo ts, BindV IO () () ts) => Foo (t ': ts) where
foo t = thenV #IO #() #() #ts (print t) (foo #ts)
I wish I could write thenV and bindV as an operator but TypeApplications doesn't work with operators.
Suppose that I'm wanting to define a data-type indexed by two type level environments. Something like:
data Woo s a = Woo a | Waa s a
data Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
The idea is that env is the input environment and env' is the output one. So, type Foo acts like an indexed state monad. So far, so good. My problem is how could I show that Foo is an applicative functor. The obvious try is
instance Applicative (Foo s env env') where
pure x = Foo (\s env -> (Woo x, env))
-- definition of (<*>) omitted.
but GHC complains that pure is ill-typed since it infers the type
pure :: a -> Foo s env env a
instead of the expected type
pure :: a -> Foo s env env' a
what is completely reasonable. My point is, it is possible to define an Applicative instance for Foo allowing to change the environment type? I googled for indexed functors, but at first sight, they don't appear to solve my problem. Can someone suggest something to achieve this?
Your Foo type is an example of what Atkey originally called a parameterised monad, and everyone else (arguably incorrectly) now calls an indexed monad.
Indexed monads are monad-like things with two indices which describe a path through a directed graph of types. Sequencing indexed monadic computations requires that the indices of the two computations line up like dominos.
class IFunctor f where
imap :: (a -> b) -> f x y a -> f x y b
class IFunctor f => IApplicative f where
ipure :: a -> f x x a
(<**>) :: f x y (a -> b) -> f y z a -> f x z b
class IApplicative m => IMonad m where
(>>>=) :: m x y a -> (a -> m y z b) -> m x z b
If you have an indexed monad which describes a path from x to y, and a way to get from y to z, the indexed bind >>>= will give you a bigger computation which takes you from x to z.
Note also that ipure returns f x x a. The value returned by ipure doesn't take any steps through the directed graph of types. Like a type-level id.
A simple example of an indexed monad, to which you alluded in your question, is the indexed state monad newtype IState i o a = IState (i -> (o, a)), which transforms the type of its argument from i to o. You can only sequence stateful computations if the output type of the first matches the input type of the second.
newtype IState i o a = IState { runIState :: i -> (o, a) }
instance IFunctor IState where
imap f s = IState $ \i ->
let (o, x) = runIState s i
in (o, f x)
instance IApplicative IState where
ipure x = IState $ \s -> (s, x)
sf <**> sx = IState $ \i ->
let (s, f) = runIState sf i
(o, x) = runIState sx s
in (o, f x)
instance IMonad IState where
s >>>= f = IState $ \i ->
let (t, x) = runIState s i
in runIState (f x) t
Now, to your actual question. IMonad, with its domino-esque sequencing, is a good abstraction for computations which transform a type-level environment: you expect the first computation to leave the environment in a state which is palatable to the second. Let us write an instance of IMonad for Foo.
I'm going to start by noting that your Woo s a type is isomorphic to (a, Maybe s), which is an example of the Writer monad. I mention this because we'll need an instance for Monad (Woo s) later and I'm too lazy to write my own.
type Woo s a = Writer (First s) a
I've picked First as my preferred flavour of Maybe monoid but I don't know exactly how you intend to use Woo. You may prefer Last.
I'm also soon going to make use of the fact that Writer is an instance of Traversable. In fact, Writer is even more traversable than that: because it contains exactly one a, we won't need to smash any results together. This means we only need a Functor constraint for the effectful f.
-- cf. traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
traverseW :: Functor f => (a -> f b) -> Writer w a -> f (Writer w b)
traverseW f m = let (x, w) = runWriter m
in fmap (\x -> writer (x, w)) (f x)
Let's get down to business.
Foo s is an IFunctor. The instance makes use of Writer s's functor-ness: we go inside the stateful computation and fmap the function over the Writer monad inside.
newtype Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
instance IFunctor (Foo s) where
imap f foo = Foo $ \s env ->
let (woo, env') = runFoo foo s env
in (fmap f woo, env')
We'll also need to make Foo a regular Functor, to use it with traverseW later.
instance Functor (Foo s x y) where
fmap = imap
Foo s is an IApplicative. We have to use Writer s's Applicative instance to smash the Woos together. This is where the Monoid s constraint comes from.
instance IApplicative (Foo s) where
ipure x = Foo $ \s env -> (pure x, env)
foo <**> bar = Foo $ \s env ->
let (woof, env') = runFoo foo s env
(woox, env'') = runFoo bar s env'
in (woof <*> woox, env'')
Foo s is an IMonad. Surprise surprise, we end up delegating to Writer s's Monad instance. Note also the crafty use of traverseW to feed the intermediate a inside the writer to the Kleisli arrow f.
instance IMonad (Foo s) where
foo >>>= f = Foo $ \s env ->
let (woo, env') = runFoo foo s env
(woowoo, env'') = runFoo (traverseW f woo) s env'
in (join woowoo, env'')
Addendum: The thing that's missing from this picture is transformers. Instinct tells me that you should be able to express Foo as a monad transformer stack:
type Foo s env env' = ReaderT s (IStateT (Sing env) (Sing env') (WriterT (First s) Identity))
But indexed monads don't have a compelling story to tell about transformers. The type of >>>= would require all the indexed monads in the stack to manipulate their indices in the same way, which is probably not what you want. Indexed monads also don't compose nicely with regular monads.
All this is to say that indexed monad transformers play out a bit nicer with a McBride-style indexing scheme. McBride's IMonad looks like this:
type f ~> g = forall x. f x -> g x
class IMonad m where
ireturn :: a ~> m a
(=<?) :: (a ~> m b) -> (m a ~> m b)
Then monad transformers would look like this:
class IMonadTrans t where
ilift :: IMonad m => m a ~> t m a
Essentially, you're missing a constraint on Sing env' - namely that it needs to be a Monoid, because:
you need to be able to generate a value of type Sing env' from nothing (e.g. mempty)
you need to be able to combine two values of type Sing env' into one during <*> (e.g. mappend).
You'll also need to the ability combine s values in <*>, so, unless you want to import SemiGroup from somewhere, you'll probably want that to be a Monoid too.
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
module SO37860911 where
import GHC.TypeLits (Symbol)
import Data.Singletons (Sing)
data Woo s a = Woo a | Waa s a
deriving Functor
instance Monoid s => Applicative (Woo s) where
pure = Woo
Woo f <*> Woo a = Woo $ f a
Waa s f <*> Woo a = Waa s $ f a
Woo f <*> Waa s a = Waa s $ f a
Waa s f <*> Waa s' a = Waa (mappend s s') $ f a
data Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
deriving Functor
instance (Monoid s, Monoid (Sing env')) => Applicative (Foo s env env') where
pure a = Foo $ \_s _env -> (pure a, mempty)
Foo mf <*> Foo ma = Foo $ \s env -> case (mf s env, ma s env) of
((w,e), (w',e')) -> (w <*> w', e `mappend` e')
What follows is a series of examples/exercises upon Lenses (by Edward Kmett) in MonadState, based on the solution of Petr Pudlak to my previous question.
In addition to demonstrate some uses and the power of the lenses, these examples show how difficult it is to understand the type signature generated by GHCi. There is hope that in the future things will improve?
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
---------- Example by Petr Pudlak ----------
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
s <- lift getLine
l %= (++ s)
-----------------------------------------------
The following comment type signatures are those produced by GHCi.
The other are adaptations from those of Peter.
Personally, I am struggling to understand than those produced by GHCi, and I wonder: why GHCi does not produce those simplified?
-------------------------------------------
-- modif2
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (Int -> p a b) -> Setting p s s a b -> t IO ()
modif2 :: (Int -> Int -> Int) -> Lens' a Int -> StateT a IO ()
modif2 f l = do
s<- lift getLine
l %= f (read s :: Int)
---------------------------------------
-- modif3
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (String -> p a b) -> Setting p s s a b -> t IO ()
modif3 :: (String -> Int -> Int) -> Lens' a Int -> StateT a IO ()
modif3 f l = do
s <- lift getLine
l %= f s
-- :t modif3 (\n -> (+) (read n :: Int)) == Lens' a Int -> StateT a IO ()
---------------------------------------
-- modif4
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (t1 -> p a b) -> (String -> t1) -> Setting p s s a b -> t IO ()
modif4 :: (Bool -> Bool -> Bool) -> (String -> Bool) -> Lens' a Bool -> StateT a IO ()
modif4 f f2 l = do
s <- lift getLine
l %= f (f2 s)
-- :t modif4 (&&) (\s -> read s :: Bool) == Lens' a Bool -> StateT a IO ()
---------------------------------------
-- modif5
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (t1 -> p a b) -> (String -> t1) -> Setting p s s a b -> t IO ()
modif5 :: (b -> b -> b) -> (String -> b) -> Lens' a b -> StateT a IO ()
modif5 f f2 l = do
s<- lift getLine
l %= f (f2 s)
-- :t modif5 (&&) (\s -> read s :: Bool) == Lens' a Bool -> StateT a IO ()
---------------------------------------
-- modif6
-- :: (Profunctor p, MonadState s m) =>
-- (t -> p a b) -> (t1 -> t) -> t1 -> Setting p s s a b -> m ()
modif6 :: (b -> b -> b) -> (c -> b) -> c -> Lens' a b -> StateT a IO ()
modif6 f f2 x l = do
l %= f (f2 x)
-- :t modif6 (&&) (\s -> read s :: Bool) "True" == MonadState s m => Setting (->) s s Bool Bool -> m ()
-- :t modif6 (&&) (\s -> read s :: Bool) "True"
---------------------------------------
-- modif7
-- :: (Profunctor p, MonadState s IO) =>
-- (t -> p a b) -> (String -> t) -> Setting p s s a b -> IO ()
modif7 :: (b -> b -> b) -> (String -> b) -> Lens' a b -> StateT a IO ()
modif7 f f2 l = do
s <- lift getLine
l %= f (f2 s)
-- :t modif7 (&&) (\s -> read s :: Bool) ==
-- :t modif7 (+) (\s -> read s :: Int) ==
---------------------------------------
p7a :: StateT Int IO ()
p7a = do
get
modif7 (+) (\s -> read s :: Int) id
test7a = execStateT p7a 10 -- if input 30 then result 40
---------------------------------------
p7b :: StateT Bool IO ()
p7b = do
get
modif7 (||) (\s -> read s :: Bool) id
test7b = execStateT p7b False -- if input "True" then result "True"
---------------------------------------
data Test = Test { _first :: Int
, _second :: Bool
}
deriving Show
$(makeLenses ''Test)
dataTest :: Test
dataTest = Test { _first = 1, _second = False }
monadTest :: StateT Test IO String
monadTest = do
get
lift . putStrLn $ "1) modify \"first\" (Int requested)"
lift . putStrLn $ "2) modify \"second\" (Bool requested)"
answ <- lift getLine
case answ of
"1" -> do lift . putStr $ "> Write an Int: "
modif7 (+) (\s -> read s :: Int) first
"2" -> do lift . putStr $ "> Write a Bool: "
modif7 (||) (\s -> read s :: Bool) second
_ -> error "Wrong choice!"
return answ
testMonadTest :: IO Test
testMonadTest = execStateT monadTest dataTest
As a family in the ML tradition, Haskell is specifically designed so that every toplevel binding has a most general type, and the Haskell implementation can and has to infer this most general type. This ensures that you can reuse the binding in as much places as possible. In a way, this means that type inference is never wrong, because whatever type you have in mind, type inference will figure out the same type or a more general type.
why GHCi does not produce those simplified?
It figures out the more general types instead. For example, you mention that GHC figures out the following type for some code:
modif2 :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
(Int -> p a b) -> Setting p s s a b -> t IO ()
This is a very general type, because every time I use modif2, I can choose different profunctors p, monad transformers t and states s. So modif2 is very reusable. You prefer this type signature:
modif2 :: (Int -> Int -> Int) -> Lens' a Int -> StateT a IO ()
I agree that this is more readable, but also less generic: Here you decided that p has to be -> and t has to be StateT, and as a user of modif2, I couldn't change that.
There is hope that in the future things will improve?
I'm sure that Haskell will continue to mandate most general types as the result of type inference. I could imagine that in addition to the most general type, ghci or a third-party tool could show you example instantiations. In this case, it would be nice to declare somehow that -> is a typical profunctor. I'm not aware of any work in this direction, though, so there is not much hope, no.
Let's look at your first example:
modif :: Lens' a String -> StateT a IO ()
modif l = do
s <- lift getLine
l %= (++ s)
This type is simple, but it has also has a shortcoming: You can only use your function passing a Lens. You cannot use your function when you have an Iso are a Traversal, even though this would make perfect sense! Given the more general type that GHCi inferes, you could for example write the following:
modif _Just :: StateT (Maybe String) IO ()
which would append the read value only if that state was a Just, or
modif traverse :: StateT [String] IO ()
which would append the read value to all elements in the list. This is not possible with the simple type you gave, because _Just and traverse are not lenses, but only Traversals.
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.