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.
Related
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')
Given the following algebraic data type:
data Foo = Bar Int | Baz Bool deriving Show
I tried to implement a Functor instance.
instance Functor Foo where
fmap f (Bar x) = Bar (f x)
fmap f (Baz x) = Baz (f x)
But I got this compile-time error:
ghci> :l explore/FunctorExplore.hs
[1 of 1] Compiling Main ( explore/FunctorExplore.hs, interpreted )
explore/FunctorExplore.hs:3:18:
The first argument of ‘Functor’ should have kind ‘* -> *’,
but ‘Foo’ has kind ‘*’
In the instance declaration for ‘Functor Foo’
Failed, modules loaded: none.
So, then I added an a in order to attempt to satisfy the compiler:
data Foo a = Bar Int | Baz Bool deriving Show
But then I got two errors that, as I understand, basically mean that an (a -> b) function can't be applied to an Int or Bool. a is a generic type, whereas the other two are specific.
ghci> :l explore/FunctorExplore.hs
[1 of 1] Compiling Main ( explore/FunctorExplore.hs, interpreted )
explore/FunctorExplore.hs:4:31:
Couldn't match expected type ‘Int’ with actual type ‘b’
‘b’ is a rigid type variable bound by
the type signature for fmap :: (a -> b) -> Foo a -> Foo b
at explore/FunctorExplore.hs:4:9
Relevant bindings include
f :: a -> b (bound at explore/FunctorExplore.hs:4:14)
fmap :: (a -> b) -> Foo a -> Foo b
(bound at explore/FunctorExplore.hs:4:9)
In the first argument of ‘Bar’, namely ‘(f x)’
In the expression: Bar (f x)
explore/FunctorExplore.hs:4:33:
Couldn't match expected type ‘a’ with actual type ‘Int’
‘a’ is a rigid type variable bound by
the type signature for fmap :: (a -> b) -> Foo a -> Foo b
at explore/FunctorExplore.hs:4:9
Relevant bindings include
f :: a -> b (bound at explore/FunctorExplore.hs:4:14)
fmap :: (a -> b) -> Foo a -> Foo b
(bound at explore/FunctorExplore.hs:4:9)
In the first argument of ‘f’, namely ‘x’
In the first argument of ‘Bar’, namely ‘(f x)’
Failed, modules loaded: none.
In this situation, it appears to me that a Functor can't be created. Is there more to my question, i.e. what am I missing?
A crucial skill in functional programming is grasping, in a given situation, the right way to do nothing. Classic errors arise, e.g., from giving [] meaning "no solutions" as the base case of a recursive search, when [[]] meaning "one trivial solution" is needed. Thus also Functor instances for phantom types, i.e. constant functors, are useful as the apparently trivial base case of a larger pattern.
I can present the general toolkit for building container-like structures as follows:
newtype K a x = K a deriving Functor -- K for konstant
{- fmap _ (K a) = K a -}
newtype I x = I x deriving Functor -- I for identity
{- fmap k (I x) = I (k x) -}
newtype P f g x = P (f x, g x) deriving Functor -- P for product
{- will give (Functor f, Functor g) => Functor (P f g), such that
fmap k (P (fx, gx)) = P (fmap k fx, fmap k gx) -}
newtype S f g x = S (Either (f x) (g x)) -- S for sum
instance (Functor f, Functor g) => Functor (S f g) where
fmap k (S (Left fx)) = S (Left (fmap k fx))
fmap k (S (Right gx)) = S (Right (fmap k gx))
Now, any recursive data structure can be presented as a top node which acts as a container for substructures.
data Data f = Node (f (Data f))
For example, if I want to make binary trees with numbers at the leaves, I can
write
type Tree = S (K Int) (P I I)
to indicate that the node structure for a tree is either a leaf with an Int and no subtrees or a fork with a pair of subtrees. I need K to point out the absence of recursive substructures. The type of trees is then Data Tree.
The usual recursion scheme for these things is
fold :: Functor f => (f t -> t) -> Data f -> t
fold k (Node fd) = k (fmap (fold k) fd)
We don't need to do any work to instantiate that for trees, because Tree is already a Functor, as it was built from functorial components. The trivial fmap for K Int amounts to saying that the recursion stops when you reach a leaf.
Of course, these "encoded" data types make it harder to see what you're doing when you write ordinary programs by pattern matching. That's where the PatternSynonyms extension comes to your rescue. You can say
pattern Leaf i = Node (S (Left (K i)))
pattern Fork l r = Node (S (Right (P (I l, I r))))
to recover the usual interface. I recommend leaving off the outer Node, to fit with the way fold strips Node for you.
pattern Leaf i = S (Left (K i))
pattern Fork l r = S (Right (P (I l, I r)))
add :: Data Tree -> Int
add = fold $ \ t -> case t of
Leaf i -> i
Fork x y -> x + y
I've barely scratched the surface of the kinds of generic functionality you can roll out to lots of data types whenever you can develop them just for K, I, P and S. The K cases are always trivial, but they have to be there.
Similar considerations apply to the Void data type (in Data.Void). Why on earth would we bother to introduce a data type with no elements worth speaking of? To model the impossible cases of a larger scheme.
Since a is a phantom type, you can't apply f at all, but you can do:
instance Functor Foo where
fmap _ (Bar x) = Bar x
fmap _ (Baz x) = Baz x
Haskell has the function join, which "runs" a monadic action which is inside a monad:
join :: Monad m => m (m a) -> m a
join m = m >>= \f -> f
We can write a similar function for monadic functions with one argument:
join1 :: Monad m => m (a -> m b) -> (a -> m b)
join1 m arg1 = m >>= \f -> f arg1
And for two arguments:
join2 :: Monad m => m (a -> b -> m c) -> (a -> b -> m c)
join2 m arg1 arg2 = m >>= \f -> f arg1 arg2
Is it possible to write a general function joinN, that can handle monadic functions with N arguments?
You can do something like this with a fair amount of ugliness if you really desire.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
import Control.Monad (join, liftM)
class Joinable m z | z -> m where
joins :: m z -> z
instance Monad m => Joinable m (m a) where
joins = join
instance (Monad m, Joinable m z) => Joinable m (r -> z) where
joins m r = joins (liftM ($ r) m)
But, as you can see this relies on some shaky typeclass magic (in particular, the unenviable UndecidableInstances). It is quite possibly better—if ugly looking—to write all of the instances join1...join10 and export them directly. This is the pattern established in the base library as well.
Notably, inference won't work too well under this regime. For instance
λ> joins (return (\a b -> return (a + b))) 1 2
Overlapping instances for Joinable ((->) t0) (t0 -> t0 -> IO t0)
arising from a use of ‘joins’
Matching instances:
instance Monad m => Joinable m (m a)
-- Defined at /Users/tel/tmp/ASD.hs:11:10
instance (Monad m, Joinable m z) => Joinable m (r -> z)
-- Defined at /Users/tel/tmp/ASD.hs:14:10
but if we give an explicit type to our argument
λ> let {q :: IO (Int -> Int -> IO Int); q = return (\a b -> return (a + b))}
then it can still work as we hope
λ> joins q 1 2
3
This arises because with typeclasses alone it becomes quite difficult to indicate whether you want to operate on the monad m in the final return type of the function chain or the monad (->) r that is the function chain itself.
The short answer is no. The slightly longer answer is you could probably define an infix operator.
Take a look at the implementation for liftM: http://hackage.haskell.org/package/base-4.7.0.2/docs/src/Control-Monad.html#liftM
It defines up to liftM5. This is because it's not possible to define liftMN, just like your joinN isn't possible.
But we can take a lesson from Appicative <$> and <*> and define our own infix operator:
> let infixr 1 <~> ; x <~> f = fmap ($ x) f
> :t (<~>)
(<~>) :: Functor f => a -> f (a -> b) -> f b
> let foo x y = Just (x + y)
> let foobar = Just foo
> join $ 1 <~> 2 <~> foobar
Just 3
This is quite reminiscent of a common applicative pattern:
f <$> a1 <*> a2 .. <*> an
join $ a1 <~> a2 .. <~> an <~> f
A single function for every possible N? Not really. Generalizing over functions with different numbers of arguments like this is difficult in Haskell, in part because "number of arguments" is not always well-defined. The following are all valid specializations of id's type:
id :: a -> a
id :: (a -> a) -> a -> a
id :: (a -> a -> a) -> a -> a -> a
...
We'd need some way to get N at the type level, and then do a different thing depending on what N is.
Existing "variadic" functions like printf do this with typeclasses. They establish what N is by induction on ->: they have a "base case" instance for a non-function type like String and a recursive instance for functions:
instance PrintfType String ...
instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) ...
We can (after a lot of thinking :P) use the same approach here, with one caveat: our base case is a bit ugly. We want to start with the normal join, which produces a result of type m a; the problem is that to support any m a, we have to overlap with normal functions. This means that we need to enable a few scary extensions and that we might confuse the type inference system when we actually use our joinN. But, with the right type signatures in place, I believe it should work correctly.
First off, here's the helper class:
class Monad m => JoinN m ma where
joinN :: m ma -> ma
ma will take the relevant function type like a -> m b, a -> b -> m c and so on. I couldn't figure out how to leave m out of the class definition, so right off the bat we need to enable MultiParamTypeClasses.
Next, our base case, which is just normal join:
instance Monad m => JoinN m (m a) where
joinN = join
Finally, we have our recursive case. What we need to do is "peel off" an argument and then implement the function in terms of a smaller joinN. We do this with ap, which is <*> specialized to monads:
instance (Monad m, JoinN m ma) => JoinN m (b -> ma) where
joinN m arg = joinN (m `ap` return arg)
We can read the => in the instance as implication: if we know how to joinN an ma, we also know how to do a b -> ma.
This instance is slightly weird, so it requires FlexibleInstances to work. More troublingly, because our base case (m (m a)) is made up entirely of variables, it actually overlaps with a bunch of other reasonable types. To actually make this work we have to enable OverlappingInstances and IncoherentInstances, which are relatively tricky and bug-prone.
After a bit of cursory testing, it seems to work:
λ> let foo' = do getLine >>= \ x -> return $ \ a b c d -> putStrLn $ a ++ x ++ b ++ x ++ c ++ x ++ d
λ> let join4 m a b c d = m >>= \ f -> f a b c d
λ> join4 foo' "a" "b" "c" "d"
a b c d
λ> joinN foo' "a" "b" "c" "d"
a b c d
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.
Sorry for the terrible title. I'm trying to make an instance of Applicative for a Monad wrapping a type that is a Monoid.
instance (Monad m, Monoid o) => Applicative (m o) where
pure x = return mempty
xm <*> ym = do
x <- xm
y <- ym
return $ x `mappend` y
This doesn't work; GCHi complains with:
Kind mis-match
The first argument of `Applicative' should have kind `* -> *',
but `m o' has kind `*'
In the instance declaration for `Applicative (m o)'
I realise that what I've written above may make no sense. Here is the context: I am trying to use the compos abstraction as described in the paper A pattern for almost compositional functions. Taking this tree (using the GADT version of compos; I've simplified it a lot):
data Tree :: * -> * where
Var :: String -> Expr
Abs :: [String] -> Expr -> Expr
App :: Expr -> [Expr] -> Expr
class Compos t where
compos :: Applicative f => (forall a. t a -> f (t a)) -> t c -> f (t c)
instance Compos Tree where
compos f t =
case t of
Abs ps e -> pure Abs <*> pure ps <*> f e
App e es -> pure App <*> f e <*> traverse f es
_ -> pure t
I'm going to write a lot of functions which descend the tree and return a list of say errors or a set of strings whilst also requiring state as it goes down (such as the binding environment), such as:
composFoldM :: (Compos t, Monad m, Monoid o) => (forall a. t a -> m o) -> t c -> m o
composFoldM f = ???
checkNames :: (Tree a) -> State (Set Name) [Error]
checkNames e =
case e of
Var n -> do
env <- get
-- check that n is in the current environment
return $ if Set.member n env then [] else [NameError n]
Abs ps e' -> do
env <- get
-- add the abstractions to the current environment
put $ insertManySet ps env
checkNames e'
_ -> composFoldM checkNames e
data Error = NameError Name
insertManySet xs s = Set.union s (Set.fromList xs)
I think these should all be able to be abstracted away by making composFoldM use compos for the (Monad m, Monoid o) => m o structure. So to use it with the GADT Applicative version of compos found on page 575/576 of the paper. I think I need to make an Applicative instance of this structure. How would I do this? Or am I going down completely the wrong path?
You want the Constant applicative from Data.Functor.Constant in the transformers package, which you can find here.
This Applicative has the following instance:
instance (Monoid a) => Applicative (Constant a) where
pure _ = Constant mempty
Constant x <*> Constant y = Constant (x `mappend` y)
You can then compose Constant with any other applicative using Compose from Data.Functor.Compose (also in the transformers package), which you can find here.
Compose has this Applicative instance:
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure x = Compose (pure (pure x))
Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
You can then Compose your Constant applicative with any other Applicative (like State) to keep both some state and a running Monoid tally.
More generally, you should read the paper The Essence of the Iterator Pattern, which discusses these patterns in more detail.