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.
Related
Exploring this material: Lens over tea I've encountered an interesting (simple at first) point:
ex3 :: (a, b) -> (b, a)
ex3 = do
a <- fst
b <- snd
return (b, a)
Everything's fine, but what type of monad does this function use (since we have a do-block inside). After a few attempts I arrived to this conclusion:
ex2 :: ReaderT (a, b) ((,) b) a
ex2 = ReaderT $ do
a <- fst
b <- snd
return (b, a)
ex3 :: (a, b) -> (b, a)
ex3 = runReaderT ex2
So, we have ReaderT that uses inner monad ((,) b). Interestingly enough - I got not enough satisfaction with this and decided to rewrite ex2 not using do-notation. This is what I got:
ex2 :: Monoid b => ReaderT (a, b) ((,) b) a
ex2 = ReaderT $
\pair -> return (fst pair) >>=
\a -> return (snd pair) >>=
\b -> (b, a)
or even:
ex2 :: Monoid b => ReaderT (a, b) ((,) b) a
ex2 = ReaderT $
\pair -> (mempty, fst pair) >>=
\a -> (mempty, snd pair) >>=
\b -> (b, a)
Both variants require b to have a Monoid type restriction.
The question is: can I write this functions with (>>=) only and without using a Monoid restriction - like we have with do-notation variant? Apparently we do the same with or without do-notation. Maybe the even difference, that we have to construct monads at every step in the second and thirst fuctions and this requires us to state that "b" should be a monoid - some monoid. And in the first case we just extract our values from some monad - not constructing them. Can anybody explain am I thinking in the right direction?
Thank you!!
You have not quite desugared this from do notation to (>>=) calls. A direct translation would look like this:
ex2 :: ReaderT (a, b) ((,) b) a
ex2 = ReaderT $
fst >>= (\a -> -- a <- fst
snd >>= (\b -> -- b <- snd
return (b, a))) -- return (b, a)
Also, you aren't actually using the monadness of (,) b, even though it fits into the slot here for the "inner monad" of ReaderT.
ex3 :: (a, b) -> (b, a)
means, in prefix notation
ex3 :: (->) (a, b) (b, a)
-----------m
------t
Hence the monad is m = (->) (a, b) which is the Reader monad (up to isomorphism) with a pair as its implicit argument / read-only state.
You don't need a monoid. The plain reader monad is enough. If you want to use ReaderT, use the identity monad as the inner monad.
ex2 :: Monoid b => ReaderT (a, b) Identity (b, a)
ex2 = ReaderT $
\pair -> Identity (fst pair) >>=
\a -> Identity (snd pair) >>=
\b -> Identity (b, a)
Of course, the code above could be simplified.
So to summarize:
Type of monad is (->) r - just function or simple reader;
How to desugar the initial function without do:
ex3' :: (a, b) -> (b, a)
ex3' = fst >>=
\a -> snd >>=
\b -> return (b, a)
I'm attempting to rewrite a simple interpreter from a transformers-based monad stack to effects based on freer, but I'm running up against a difficulty communicating my intent to GHC's type system.
I am only using the State and Fresh effects at present. I'm using two states and my effect runner looks like this:
runErlish g ls = run . runGlobal g . runGensym 0 . runLexicals ls
where runGlobal = flip runState
runGensym = flip runFresh'
runLexicals = flip runState
On top of this, I have defined a function FindMacro with this type:
findMacro :: Members [State (Global v w), State [Scope v w]] r
=> Arr r Text (Maybe (Macro (Term v w) v w))
All of this so far works perfectly fine. The problem comes when I try to write macroexpand2 (well, macroexpand1, but i'm simplifying it so the question is easier to follow):
macroexpand2 s =
do m <- findMacro s
return $ case m of
Just j -> True
Nothing -> False
This produces the following error:
Could not deduce (Data.Open.Union.Member'
(State [Scope v0 w0])
r
(Data.Open.Union.FindElem (State [Scope v0 w0]) r))
from the context (Data.Open.Union.Member'
(State [Scope v w])
r
(Data.Open.Union.FindElem (State [Scope v w]) r),
Data.Open.Union.Member'
(State (Global v w))
r
(Data.Open.Union.FindElem (State (Global v w)) r))
bound by the inferred type for `macroexpand2':
(Data.Open.Union.Member'
(State [Scope v w])
r
(Data.Open.Union.FindElem (State [Scope v w]) r),
Data.Open.Union.Member'
(State (Global v w))
r
(Data.Open.Union.FindElem (State (Global v w)) r)) =>
Text -> Eff r Bool
at /tmp/flycheck408QZt/Erlish.hs:(79,1)-(83,23)
The type variables `v0', `w0' are ambiguous
When checking that `macroexpand2' has the inferred type
macroexpand2 :: forall (r :: [* -> *]) v (w :: [* -> *]).
(Data.Open.Union.Member'
(State [Scope v w])
r
(Data.Open.Union.FindElem (State [Scope v w]) r),
Data.Open.Union.Member'
(State (Global v w))
r
(Data.Open.Union.FindElem (State (Global v w)) r)) =>
Text -> Eff r Bool
Probable cause: the inferred type is ambiguous
Okay, I can add a Members annotation to the type:
macroexpand2 :: Members [State (Global v w), State [Scope v w]] r
=> Text -> Eff r Bool
And now I get this:
Overlapping instances for Member (State [Scope v0 w0]) r
arising from a use of `findMacro'
Matching instances:
instance Data.Open.Union.Member'
t r (Data.Open.Union.FindElem t r) =>
Member t r
-- Defined in `Data.Open.Union'
There exists a (perhaps superclass) match:
from the context (Members
'[State (Global v w), State [Scope v w]] r)
bound by the type signature for
macroexpand2 :: Members
'[State (Global v w), State [Scope v w]] r =>
Text -> Eff r Bool
at /tmp/flycheck408QnV/Erlish.hs:(79,17)-(80,37)
(The choice depends on the instantiation of `r, v0, w0'
To pick the first instance above, use IncoherentInstances
when compiling the other instance declarations)
In a stmt of a 'do' block: m <- findMacro s
In the expression:
do { m <- findMacro s;
return
$ case m of {
Just j -> True
Nothing -> False } }
In an equation for `macroexpand2':
macroexpand2 s
= do { m <- findMacro s;
return
$ case m of {
Just j -> True
Nothing -> False } }
I was advised on irc to try forall r v w. which made no difference. Out of curiosity i tried using IncoherentInstances when compiling this code (I did not fancy checking out a fork of freer and playing) to see if perhaps it would give me a clue as to what was going on. It did not:
Could not deduce (Data.Open.Union.Member'
(State [Scope v0 w0])
r
(Data.Open.Union.FindElem (State [Scope v0 w0]) r))
arising from a use of `findMacro'
from the context (Members
'[State (Global v w), State [Scope v w]] r)
bound by the type signature for
macroexpand2 :: Members
'[State (Global v w), State [Scope v w]] r =>
Text -> Eff r Bool
at /tmp/flycheck408eru/Erlish.hs:(79,17)-(80,37)
The type variables `v0', `w0' are ambiguous
Relevant bindings include
macroexpand2 :: Text -> Eff r Bool
(bound at /tmp/flycheck408eru/Erlish.hs:81:1)
Note: there are several potential instances:
instance (r ~ (t' : r'), Data.Open.Union.Member' t r' n) =>
Data.Open.Union.Member' t r ('Data.Open.Union.S n)
-- Defined in `Data.Open.Union'
instance (r ~ (t : r')) =>
Data.Open.Union.Member' t r 'Data.Open.Union.Z
-- Defined in `Data.Open.Union'
In a stmt of a 'do' block: m <- findMacro s
In the expression:
do { m <- findMacro s;
return
$ case m of {
Just j -> True
Nothing -> False } }
In an equation for `macroexpand2':
macroexpand2 s
= do { m <- findMacro s;
return
$ case m of {
Just j -> True
Nothing -> False } }
So, this is where my understanding of freer's internals runs out and I have questions:
Why is there an overlapping instance? I don't understand where that's coming from.
What does IncoherentInstances actually do? Autoselection sounds pretty likely to cause hard-to-debug errors.
How do I actually make use of findMacro within another function?
Cheers!
Type inference for extensible effects has been historically bad. Let's see some examples:
{-# language TypeApplications #-}
-- mtl
import qualified Control.Monad.State as M
-- freer
import qualified Control.Monad.Freer as F
import qualified Control.Monad.Freer.State as F
-- mtl works as usual
test1 = M.runState M.get 0
-- this doesn't check
test2 = F.run $ F.runState F.get 0
-- this doesn't check either, although we have a known
-- monomorphic state type
test3 = F.run $ F.runState F.get True
-- this finally checks
test4 = F.run $ F.runState (F.get #Bool) True
-- (the same without TypeApplication)
test5 = F.run $ F.runState (F.get :: F.Eff '[F.State Bool] Bool) True
I'll try to explain the general issue and provide minimal code illustration. A self-contained version of the code can be found here.
On the most basic level (disregarding optimized representations), Eff is defined the following way:
{-# language
GADTs, DataKinds, TypeOperators, RankNTypes, ScopedTypeVariables,
TypeFamilies, DeriveFunctor, EmptyCase, TypeApplications,
UndecidableInstances, StandaloneDeriving, ConstraintKinds,
MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
AllowAmbiguousTypes, PolyKinds
#-}
import Control.Monad
data Union (fs :: [* -> *]) (a :: *) where
Here :: f a -> Union (f ': fs) a
There :: Union fs a -> Union (f ': fs) a
data Eff (fs :: [* -> *]) (a :: *) =
Pure a | Free (Union fs (Eff fs a))
deriving instance Functor (Union fs) => Functor (Eff fs)
In other words, Eff is a free monad from an union of a list of functors. Union fs a behaves like an n-ary Coproduct. The binary Coproduct is like Either for two functors:
data Coproduct f g a = InL (f a) | InR (g a)
In contrast, Union fs a lets us choose a functor from a list of functors:
type MyUnion = Union [[], Maybe, (,) Bool] Int
-- choose the first functor, which is []
myUnion1 :: MyUnion
myUnion1 = Here [0..10]
-- choose the second one, which is Maybe
myUnion2 :: MyUnion
myUnion2 = There (Here (Just 0))
-- choose the third one
myUnion3 :: MyUnion
myUnion3 = There (There (Here (False, 0)))
Let's implement the State effect as an example. First, we need to have a Functor instance for Union fs, since Eff only has a Monad instance if Functor (Union fs).
Functor (Union '[]) is trivial, since the empty union doesn't have values:
instance Functor (Union '[]) where
fmap f fs = case fs of {} -- using EmptyCase
Otherwise we prepend a functor to the union:
instance (Functor f, Functor (Union fs)) => Functor (Union (f ': fs)) where
fmap f (Here fa) = Here (fmap f fa)
fmap f (There u) = There (fmap f u)
Now the State definition and the runners:
run :: Eff '[] a -> a
run (Pure a) = a
data State s k = Get (s -> k) | Put s k deriving Functor
runState :: forall s fs a. Functor (Union fs) => Eff (State s ': fs) a -> s -> Eff fs (a, s)
runState (Pure a) s = Pure (a, s)
runState (Free (Here (Get k))) s = runState (k s) s
runState (Free (Here (Put s' k))) s = runState k s'
runState (Free (There u)) s = Free (fmap (`runState` s) u)
We can already start writing and running our Eff programs, although we lack all the sugar and convenience:
action1 :: Eff '[State Int] Int
action1 =
Free $ Here $ Get $ \s ->
Free $ Here $ Put (s + 10) $
Pure s
-- multiple state
action2 :: Eff '[State Int, State Bool] ()
action2 =
Free $ Here $ Get $ \n -> -- pick the first effect
Free $ There $ Here $ Get $ \b -> -- pick the second effect
Free $ There $ Here $ Put (n < 10) $ -- the second again
Pure ()
Now:
> run $ runState action1 0
(0,10)
> run $ (`runState` False) $ (`runState` 0) action2
(((),0),True)
There are only two essential missing things here.
The first one is the monad instance for Eff which lets us use do-notation instead of Free and Pure, and also lets us use the many polymorphic monadic functions. We shall skip it here because it's straightforward to write.
The second one is inference/overloading for choosing effects from lists of effects. Previously we needed to write Here x in order to choose the first effect, There (Here x) to choose the second one, and so on. Instead, we'd like to write code that's polymorphic in effect lists, so all we have to specify is that some effect is an element of a list, and some hidden typeclass magic will insert the appropriate number of There-s.
We need a Member f fs class that can inject f a-s into Union fs a-s when f is an element of fs. Historically, people have implemented it in two ways.
First, directly with OverlappingInstances:
class Member (f :: * -> *) (fs :: [* -> *]) where
inj :: f a -> Union fs a
instance Member f (f ': fs) where
inj = Here
instance {-# overlaps #-} Member f fs => Member f (g ': fs) where
inj = There . inj
-- it works
injTest1 :: Union [[], Maybe, (,) Bool] Int
injTest1 = inj [0]
injTest2 :: Union [[], Maybe, (,) Bool] Int
injTest2 = inj (Just 0)
Second, indirectly, by first computing the index of f in fs with a type family, then implementing inj with a non-overlapping class, guided by f-s computed index. This is generally viewed as better because people tend to dislike overlapping instances.
data Nat = Z | S Nat
type family Lookup f fs where
Lookup f (f ': fs) = Z
Lookup f (g ': fs) = S (Lookup f fs)
class Member' (n :: Nat) (f :: * -> *) (fs :: [* -> *]) where
inj' :: f a -> Union fs a
instance fs ~ (f ': gs) => Member' Z f fs where
inj' = Here
instance (Member' n f gs, fs ~ (g ': gs)) => Member' (S n) f fs where
inj' = There . inj' #n
type Member f fs = Member' (Lookup f fs) f fs
inj :: forall fs f a. Member f fs => f a -> Union fs a
inj = inj' #(Lookup f fs)
-- yay
injTest1 :: Union [[], Maybe, (,) Bool] Int
injTest1 = inj [0]
The freer library uses the second solution, while extensible-effects uses the first one for GHC versions older than 7.8, and the second for newer GHC-s.
Anyway, both solutions have the same inference limitation, namely that we can almost always Lookup only concrete monomorphic types, not types that contain type variables. Examples in ghci:
> :kind! Lookup Maybe [Maybe, []]
Lookup Maybe [Maybe, []] :: Nat
= 'Z
This works because there are no type variables in either Maybe or [Maybe, []].
> :kind! forall a. Lookup (Either a) [Either Int, Maybe]
forall a. Lookup (Either a) [Either Int, Maybe] :: Nat
= Lookup (Either a) '[Either Int, Maybe]
This one gets stuck because the a type variable blocks reduction.
> :kind! forall a. Lookup (Maybe a) '[Maybe a]
forall a. Lookup (Maybe a) '[Maybe a] :: Nat
= Z
This works, because the only thing we know about arbitrary type variables is that they are equal to themselves, and a is equal to a.
In general, type family reduction gets stuck on variables, because constraint solving can potentially refine them later to different types, so GHC can't make any assumptions about them (aside from being equal to themselves). Essentially the same issue arises with the OverlappingInstances implementation (although there aren't any type families).
Let's revisit freer in the light of this.
import Control.Monad.Freer
import Control.Monad.Freer.State
test1 = run $ runState get 0 -- error
GHC knows that we have a stack with a single effect, since run works on Eff '[] a. It also knows that that effect must be State s. But when we write get, GHC only knows that it has a State t effect for some fresh t variable, and that Num t must hold, so when it tries to compute the freer equivalent of Lookup (State t) '[State s], it gets stuck on the type variables, and any further instance resolution trips up on the stuck type family expression. Another example:
foo = run $ runState get False -- error
This also fails because GHC needs to compute Lookup (State s) '[State Bool], and although we know that the state must be Bool, this still gets stuck because of the s variable.
foo = run $ runState (modify not) False -- this works
This works because the state type of modify not can be resolved to Bool, and Lookup (State Bool) '[State Bool] reduces.
Now, after this large detour, I shall address your questions at the end of your post.
Overlapping instances is not indicative of any possible solution, just a type error artifact. I would need more code context to pinpoint how exactly it arises, but I'm sure it's not relevant, since as soon as Lookup gets stuck the case becomes hopeless.
IncoherentInstances is also irrelevant and doesn't help. We need a concrete effect position index to be able to generate code for the program, and we can't pull an index out of thin air if Lookup gets stuck.
The problem with findMacro is that it has State effects with type variables inside the states. Whenever you want to use findMacro you have to make sure that the v and w parameters for Scope and Global are known concrete types. You can do this by type annotations, or more conveniently you can use TypeApplications, and write findMacro #Int #Int for specifying v = Int and w = Int. If you have findMacro inside a polymorphic function, you need to enable ScopedTypeVariables, bind v and w using a forall v w. annotation for that function, and write findMacro #v #w when you use it. You also need to enable {-# language AllowAmbiguousTypes #-} for polymorphic v or w (as pointed out in the comments). I think though that in GHC 8 it's a reasonable extension to enable, together with TypeApplications.
Addendum:
However, fortunately new GHC 8 features let us repair type inference for extensible effects, and we can infer everything mtl can, and also some things mtl can't handle. The new type inference is also invariant with respect to the ordering of effects.
I have a minimal implementation here along with a number of examples. However, it's not yet used in any effect library that I know of. I'll probably do a write-up on it, and do a pull request in order to add it to freer.
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')
IORefs, MVars, and TVars can be used to wrap a shared variable in a concurrent context. I've studied concurrent haskell for a while and now I've encounted some questions. After searching on stackoverflow and read through some related question, my questions are not fully resolved.
According to the IORef documentation,"Extending the atomicity to multiple IORefs is problematic", can someone help to explain why a single IORef is safe but more than one IORefs are problematic?
modifyMVar is "exception-safe, but only atomic if there are no other producers for this MVar". See MVar's documentation. The source code show that modifyMVar does only compose a getMVar and putMVar sequencially, indicating that it's note thread-safe if there is another producer. But if there is no producer and all threads behave in the "takeMVar then putMVar" way, then is it thread-safe to simply use modifyMVar ?
To give a concrete situation, I'll show the actual problem. I've some shared variables which are never empty and I want them be mutable states so some threads can simultaneously modify these variables.
OK, it seems tha TVar solve everything clearly. But I'm not satisfied with it and I'm eager for answers to the questions above. Any help are appreciated.
-------------- re: #GabrielGonzalez BFS interface code ------------------
Code below is my BFS interface using state monad.
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
module Data.Graph.Par.Class where
import Data.Ix
import Data.Monoid
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans.State
class (Ix (Vertex g), Ord (Edge g), Ord (Path g)) => ParGraph g where
type Vertex g :: *
type Edge g :: *
-- type Path g :: * -- useless
type VertexProperty g :: *
type EdgeProperty g :: *
edges :: g a -> IO [Edge g]
vertexes :: g a -> IO [Vertex g]
adjacencies :: g a -> Vertex g -> IO [Vertex g]
vertexProperty :: Vertex g -> g a -> IO (VertexProperty g)
edgeProperty :: Edge g -> g a -> IO (EdgeProperty g)
atomicModifyVertexProperty :: (VertexProperty g -> IO (VertexProperty g)) ->
Vertex g -> g a -> IO (g a) -- fixed
spanForest :: ParGraph g => [Vertex g] -> StateT (g a) IO ()
spanForest roots = parallelise (map spanTree roots) -- parallel version
spanForestSeq :: ParGraph g => [Vertex g] -> StateT (g a) IO ()
spanForestSeq roots = forM_ roots spanTree -- sequencial version
spanTree :: ParGraph g => Vertex g -> StateT (g a) IO ()
spanTree root = spanTreeOneStep root >>= \res -> case res of
[] -> return ()
adjs -> spanForestSeq adjs
spanTreeOneStep :: ParGraph g => Vertex g -> StateT (g a) IO [Vertex g]
spanTreeOneStep v = StateT $ \g -> adjacencies g v >>= \adjs -> return (adjs, g)
parallelise :: (ParGraph g, Monoid b) => [StateT (g a) IO b] -> StateT (g a) IO b
parallelise [] = return mempty
parallelise ss = syncGraphOp $ map forkGraphOp ss
forkGraphOp :: (ParGraph g, Monoid b) => StateT (g a) IO b -> StateT (g a) IO (MVar b)
forkGraphOp t = do
s <- get
mv <- mapStateT (forkHelper s) t
return mv
where
forkHelper s x = do
mv <- newEmptyMVar
forkIO $ x >>= \(b, s) -> putMVar mv b
return (mv, s)
syncGraphOp :: (ParGraph g, Monoid b) => [StateT (g a) IO (MVar b)] -> StateT (g a) IO b
syncGraphOp [] = return mempty
syncGraphOp ss = collectMVars ss >>= waitResults
where
collectMVars [] = return []
collectMVars (x:xs) = do
mvx <- x
mvxs <- collectMVars xs
return (mvx:mvxs)
waitResults mvs = StateT $ \g -> forM mvs takeMVar >>= \res -> return ((mconcat res), g)
Modern processors offer a compare-and-swap instruction that atomically modifies a single pointer. I expect if you track down deep enough, you will find that this instruction is the one used to implement atomicModifyIORef. It is therefore easy to provide atomic access to a single pointer. However, because there isn't such hardware support for more than one pointer, whatever you need will have to be done in software. This typically involves inventing and manually enforcing a protocol in all your threads -- which is complicated and error-prone.
Yes, if all threads agree to only use the "single takeMVar followed by a single putMVar" behavior, then modifyMVar is safe.
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.)