Lets say I have:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
import Control.Lens
data T a b = T { _foo :: a
, _bar :: a -> b
}
makeLenses ''T
a appears in both foo and bar, so updates have to be "simulatenous", as it were. This is possible without lenses:
eg1 :: T a (b -> c) -> b -> T (a, b) c
eg1 (T foo bar) b = T (foo, b) (uncurry bar)
But how can I do this with lenses? The following doesn't work with an occurs check:
eg :: T a (b -> c) -> b -> T (a, b) c
eg t b = t & foo %~ (, b) & bar %~ uncurry
You can't do this using the automatically generated lenses for T. If you want to stretch things a bit, you can first define
data T' a b c = T' { _foo' :: c, _bar' :: a -> b}
tt :: Iso (T a b) (T a' b') (T' a b a) (T' a' b' a')
tt = dimap (\(T x g) -> T' x g) (fmap (\(T' x g) -> T x g))
Then you can (automatically) build type-changing lenses for T' and use tt to use them to modify values of type T a b through the isomorphism.
For example, rearranging the arguments a bit, you can write
eg :: b -> T a (b -> c) -> T (a, b) c
eg b = over tt $ (foo' %~ (,b)) . (bar' %~ uncurry)
Another approach that will likely be better if you don't need to fuss around with T too much is to define it as a newtype around T':
newtype T a b = T { getT :: T' a b a }
Then you can skip the Iso and just compose things. Rearranging the arguments the same way,
eg' :: b -> T a (b -> c) -> T (a, b) c
eg' b = T . (foo' %~ (,b)) . (bar' %~ uncurry) . getT
Related
In a previous question I asked how a record field can be made polymorphic when using DuplicateRecordFields. I got an excellent answer for this from #user2407038. He answered the question to my initial spec providing one type class per field, but he mentioned that it could all be simplified into one typeclass.
(Note: this too can be generalized to a single class with an additional parameter corresponding to the field name; this is probably outside the scope of this question).
I'm not sure how to go about doing this generalization. Does anybody have any ideas on how this can accomplished?
Defining such a class is easy enough
-- s has a field named field of type a and setting it to b turns the s into a t
class HasLens field s t a b | field s -> a, field t -> b, field s b -> t, field t a -> s where
-- Fundeps are pretty common sense, and also appear in the library linked in the comments
lensOf :: Functor f => (a -> f b) -> s -> f t
-- Not sure why the library linked above includes f in the class head...
You'll notice that field appears nowhere in lensOf's type, so this class would be unusable as is, because the inferencer can never figure out what it should be. You have these options:
Old:
class HasLens name s t a b | ... where
lensOf :: Functor f => Proxy name -> (a -> f b) -> s -> f t
-- Or Proxy#, which has no runtime overhead, or forall proxy. Functor f => proxy name -> ...
The Proxy argument is a dummy; it is never used for anything except telling the compiler about name. Usage is unbearably ugly, though:
lensOf (Proxy :: Proxy "field")
-- or proxy#, or undefined
New:
{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}
Now you use explicit type applications to set name at the call site (also make sure that name is first in the class head, or else the order of type arguments will get messed up).
lensOf #"field"
Fuller example:
{-# LANGUAGE AllowAmbiguousTypes
, DataKinds
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, NoMonomorphismRestriction
, PolyKinds
, ScopedTypeVariables
, TypeApplications
#-}
import Control.Lens
class HasLens x s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where
lensOf :: Functor f => (a -> f b) -> s -> f t
data Tup2 a b = Tup2 { _left2 :: a, _right2 :: b } deriving Show
data Tup3 a b c = Tup3 { _left3 :: a, _middle3 :: b, _right3 :: c } deriving Show
instance HasLens "left" (Tup2 a b) (Tup2 a' b) a a' where
lensOf = lens _left2 $ \t x -> t { _left2 = x }
instance HasLens "left" (Tup3 a b c) (Tup3 a' b c) a a' where
lensOf = lens _left3 $ \t x -> t { _left3 = x }
instance HasLens "right" (Tup2 a b) (Tup2 a b') b b' where
lensOf = lens _right2 $ \t x -> t { _right2 = x }
instance HasLens "right" (Tup3 a b c) (Tup3 a b c') c c' where
lensOf = lens _right3 $ \t x -> t { _right3 = x }
swap' :: forall xlr xrl l r xll xrr. (HasLens "left" xlr xrr l r, HasLens "right" xlr xll r l, HasLens "left" xll xrl l r, HasLens "right" xrr xrl r l) => xlr -> xrl
swap' x = x & lensOf #"left" .~ x^#lensOf #"right" #xlr #xll #r #l
& lensOf #"right" .~ x^#lensOf #"left" #xlr #xrr #l #r
main = do out $ Tup2 5 6
out $ Tup3 'l' 'm' 'r'
out $ Tup2 "l" 'r'
out $ Tup3 17 [5,10] "a"
where out = print . swap'
We can have a polymorphic function f :: a -> b implemented for different pairs of a and b. How can we make
twice :: (a -> b) -> a -> c
twice f x = f (f x)
type check? i.e. how can I write a function which applies a polymorphic function twice?
With Rank2Types we can get a bit closer but not quite there:
{-# LANGUAGE Rank2Types #-}
twice1 :: (forall a. a -> (m a)) -> b -> (m (m b))
twice1 f = f . f
twice2 :: (forall a. m a -> a) -> m (m b) -> b
twice2 f = f . f
so then some polymorphic functions can be applied twice:
\> twice1 (:[]) 1
[[1]]
\> twice2 head [[1]]
1
Can we go further?
The question was asked over Haskell cafe 10 years ago but wasn't quite answered (with type classes it becomes a lot of boilerplate).
{-# LANGUAGE TypeFamilies, RankNTypes, UnicodeSyntax #-}
type family Fundep a :: *
type instance Fundep Bool = Int
type instance Fundep Int = String
...
twice :: ∀ a . (∀ c . c -> Fundep c) -> a -> Fundep (Fundep a)
twice f = f . f
Now, that won't be much use actually because you can't define a (meaningful) polymorphic function that works with any c. One possibility is to toss in a class constraint, like
class Showy a where
type Fundep a :: *
showish :: a -> Fundep a
instance Showy Bool where
type Fundep Bool = Int
showish = fromEnum
instance Showy Int where
type Fundep Int = String
showish = show
twice :: ∀ a b . (Showy a, b ~ Fundep a, Showy b) =>
(∀ c . Showy c => c -> Fundep c) -> a -> Fundep b
twice f = f . f
main = print $ twice showish False
You can't make twice generic enough even in a dependently typed setting, but it's possible with intersection types:
twice :: (a -> b /\ b -> c) -> a -> c
twice f x = f (f x)
Now whenever f :: a -> b and f :: b -> c typecheck, twice will typecheck too.
There is also a beautiful spell in Benjamin Pierce's thesis (I changed the syntax slightly):
self : (A /\ A -> B) -> B
self f = f f
So self-application is typeable with intersection types as well.
I've got some code that compiles:
{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs,
FlexibleContexts #-}
module Foo where
data Foo :: (* -> *) where
Foo :: c m zp' -> Foo (c m zp)
f :: forall c m zp d . Foo (c m zp) -> d
f y#(Foo (x :: c m a)) = g x y
g :: c m a -> Foo (c m b) -> d
g = error ""
The key thing I need in my real code is to convince GHC that if y has the type Foo (c m zp) and x has the type c' m' zp', then c' ~ c and m' ~ m. The above code achieves this because I am able to call g.
I want to change this code in two orthogonal ways, but I can't seem to figure out how to make GHC compile the code with either change.
First change: Add -XPolyKinds. GHC 7.8.3 complains:
Foo.hs:10:11:
Could not deduce ((~) (k2 -> k3 -> *) c1 c)
from the context ((~) * (c m zp) (c1 m1 zp1))
bound by a pattern with constructor
Foo :: forall (k :: BOX)
(k :: BOX)
(c :: k -> k -> *)
(m :: k)
(zp' :: k)
(zp :: k).
c m zp' -> Foo (c m zp),
in an equation for ‘f’
at Foo.hs:10:6-21
‘c1’ is a rigid type variable bound by
a pattern with constructor
Foo :: forall (k :: BOX)
(k :: BOX)
(c :: k -> k -> *)
(m :: k)
(zp' :: k)
(zp :: k).
c m zp' -> Foo (c m zp),
in an equation for ‘f’
at Foo.hs:10:6
‘c’ is a rigid type variable bound by
the type signature for f :: Foo (c m zp) -> d
at Foo.hs:9:13
Expected type: c1 m1 zp'
Actual type: c m a
Relevant bindings include
y :: Foo (c m zp) (bound at Foo.hs:10:3)
f :: Foo (c m zp) -> d (bound at Foo.hs:10:1)
In the pattern: x :: c m a
In the pattern: Foo (x :: c m a)
In an equation for ‘f’: f y#(Foo (x :: c m a)) = g x y
Foo.hs:10:11:
Could not deduce ((~) k2 m1 m)
from the context ((~) * (c m zp) (c1 m1 zp1))
...
Second change: Forget about -XPolyKinds. Instead I want to use -XDataKinds to create a new kind and restrict the kind of m:
{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs,
FlexibleContexts, DataKinds #-}
module Foo where
data Bar
data Foo :: (* -> *) where
Foo :: c (m :: Bar) zp' -> Foo (c m zp)
f :: forall c m zp d . Foo (c m zp) -> d
f y#(Foo (x :: c m a)) = g x y
g :: c m a -> Foo (c m b) -> d
g = error ""
I get similar errors (can't deduce (c1 ~ c), can't deduce (m1 ~ m)).
DataKinds seems to be relevant here: if I restrict m to have kind Constraint instead of kind Bar, the code compiles fine.
I've given two examples of how to break the original code, both of which use higher-kinded types. I've tried using case statements instead of pattern guards, I've tried giving a type to node instead of x, my usual tricks aren't working here.
I'm not picky about where the type for x ends up/what it looks like, I just need to be able to convince GHC that if y has the type Foo (c m zp), then x has the type c m zp' for some unrelated type zp'.
I greatly simplified the original question to the following, which compiles without {-# LANGUAGE PolyKinds #-} but fails to compile with PolyKinds.
{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs #-}
{-# LANGUAGE PolyKinds #-}
data Pair1 :: (* -> *) where
Pair1 :: Pair1 (c a, c b)
data D p a where
D :: p (a, b) -> D p a -> D p b
f :: forall c z. D Pair1 (c z) -> D Pair1 (c z)
f y#(D Pair1 x) |
(_ :: D Pair1 (c z)) <- y,
(_ :: D Pair1 (c z')) <- x = y
With PolyKinds enabled the compiler error is
Could not deduce (c1 ~ c)
from the context ((a, c z) ~ (c1 a1, c1 b))
This error strongly suggests what I already suspected, that an answer depends on whether polykinded type application is injective. If polykinded type application were injective, we could deduce c1 ~ c as follows.
(a, c z) ~ (c1 a1, c1 b)
(a,) (c z) ~ (c1 a1,) (c1 b) {- switch to prefix notation -}
c z ~ c1 b {- f a ~ g b implies a ~ b -}
c ~ c1 {- f a ~ g b implies f ~ g -}
c1 ~ c {- ~ is reflexive -}
Polykinded type application is injective, but ghc doesn't know it. In order for ghc to deduce that the type application is injective, we need to provide kind signatures so that the compiler is aware the kinds are equivalent.
I haven't found sufficient kind annotations for your original, over-simplified version of the problem. When simplifying problems juggling types, reducing a type to essentially a Proxy is sometimes excessive, as it leaves fewer places to attach type signatures. You have found places to attach kind signatures to a more meaningful problem.
The problem can be resolved by adding kind signatures.
For example, when using -XPolyKinds, the following code compiles:
{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs,
FlexibleContexts, PolyKinds #-}
module Foo where
data Foo :: (* -> *) where
Foo :: (c :: k -> * -> *) m zp' -> Foo (c m zp)
f :: forall (c :: k -> * -> *) m zp d . Foo (c m zp) -> d
f y#(Foo x) = g x y
g :: c m a -> Foo (c m b) -> d
g = error ""
For the -XDataKinds version, I also need a kind signature on g:
{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs,
FlexibleContexts, DataKinds #-}
module Foo where
data Bar
data Foo :: (* -> *) where
Foo :: (c :: Bar -> * -> *) m zp' -> Foo (c m zp)
f :: forall (c :: Bar -> * -> *) m zp d . Foo (c m zp) -> d
f y#(Foo x) = g x y
g :: forall (c :: Bar -> * -> *) m a b d . c m a -> Foo (c m b) -> d
g = error ""
Not sure why I need more sigs for DataKinds, and it's a bit annoying to have to copy them everywhere, but it does get the job done.
Using a lens library I can apply a modification function to individual targets, like so:
Prelude Control.Lens> (1, 'a', 2) & _1 %~ (*3)
(3,'a',2)
Prelude Control.Lens> (1, 'a', 2) & _3 %~ (*3)
(1,'a',6)
How can I combine those individual lenses (_1 and _3) to be able to perform this update to both of the targets at once? I expect something in the spirit of the following:
Prelude Control.Lens> (1, 'a', 2) & ??? %~ (*3)
(3,'a',6)
Using untainted from the Settable type class in Control.Lens.Internal.Setter, it is possible to combine two setters, but the result will also only be a setter and not a getter.
import Control.Lens.Internal.Setter
-- (&&&) is already taken by Control.Arrow
(~&~) :: (Settable f) => (c -> d -> f a) -> (c -> a -> t) -> c -> d -> t
(~&~) a b f = b f . untainted . a f
You can test this:
>>> import Control.Lens
>>> (1, 'a', 2) & (_1 ~&~ _3) %~ (*3)
(3,'a',6)
EDIT
You don't actually need to use internal functions. You can use the fact that Mutator is a monad:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Control.Applicative
(~&~) = liftA2 (>=>)
-- This works too, and is maybe easier to understand:
(~&~) a b f x = a f x >>= b f
There is a variation on what you are asking for which is more general:
(/\)
:: (Functor f)
=> ((a -> (a, a)) -> (c -> (a, c)))
-- ^ Lens' c a
-> ((b -> (b, b)) -> (c -> (b, c)))
-- ^ Lens' c b
-> (((a, b) -> f (a, b)) -> (c -> f c))
-- ^ Lens' c (a, b)
(lens1 /\ lens2) f c0 =
let (a, _) = lens1 (\a_ -> (a_, a_)) c0
(b, _) = lens2 (\b_ -> (b_, b_)) c0
fab = f (a, b)
in fmap (\(a, b) ->
let (_, c1) = lens1 (\a_ -> (a_, a)) c0
(_, c2) = lens2 (\b_ -> (b_, b)) c1
in c2
) fab
infixl 7 /\
Just focus on the type signature with lens type synonyms:
Lens' c a -> Lens' c b -> Lens' c (a, b)
It takes two lenses and combines them into a lens to a pair of fields. This is slightly more general and works for combining lenses that point to fields of different types. However, then you'd have to mutate the two fields separately.
I just wanted to throw this solution out there in case people were looking for something like this.
I want to implement an arrow with an arr-member-function showing a different behavior for function arguments with different types, for instance arr (\x -> (x,x)) should behave differently from arr id...
Here's the code:
{-# LANGUAGE Arrows, OverlappingInstances, IncoherentInstances, FlexibleInstances#-}
import Control.Arrow
import Control.Category
import Prelude hiding (id, (.))
class ToPredefinedStr a where
toStr :: a -> String
instance ToPredefinedStr ((->) b (b,b)) where
toStr _ = "b -> (b,b)"
instance ToPredefinedStr (a -> (b,c)) where
toStr _ = "a -> (b,c)"
instance ToPredefinedStr ((a,b) -> c) where
toStr _ = "(a,b) -> c"
instance ToPredefinedStr (a -> b) where
toStr _ = "a -> b"
newtype MyArrow a b c = MA (a b (c, String))
instance (Category a, Arrow a) => Category (MyArrow a) where
-- irrelevant for this example ...
instance (Arrow a) => Arrow (MyArrow a) where
arr f = MA (arr (\x -> (f x, toStr f)))
appMyArr (MA a) = a
But: It shows the following very strange behavor:
> toStr (\x -> (x,x)) -- that works as expected!
"b -> (b,b)"
> appMyArr (arr (\x -> (x,x))) () -- but this does'nt!!
(((),()),"a -> b")
Can anyone explain how to get ghci to choose the b -> (b,b)-instance for the expression \x -> (x,x) in the second example?
If you use IncoherentInstances anything can happen. There is no longer any promise the instances are picked in a coherent way.
The short answer is that this happens because the compiler has access to more specific type information in the first case than in the second.
When compiling your definition of arr, the compiler only sees the type of the function argument f as b -> c, so when considering the call toStr f it has to choose an instance based on only this information. After all, arr might be called with any function. It is clear that it can only choose the instance ToPredefinedStr (a -> b).
Now, when we inline it like in toStr (\b -> (b, b)), the compiler has more information available at the call site, and can choose the more specific instance.
And no, using INLINE pragmas won't change the instance selection if you were thinking of that.
For what you're trying to achieve, the closest I can think of would be to restrict the types so that the instance selection will happen outside arr:
{-# LANGUAGE FlexibleContexts, ... #-}
class FancyArrow a where
myArr :: (ToPredefinedStr (b -> c)) => (b -> c) -> a b c
...
instance (Arrow a) => FancyArrow (MyArrow a) where
myArr f = MA (arr (\x -> (f x, toStr f)))
This gives the result you wanted.
*Main> appMyArr (myArr (\x -> (x,x))) ()
(((),()),"b -> (b,b)")
Note that this is somewhat brittle, as you have to control where the choice of instance is made by propagating the ToPredefinedStr constraint. For example, this function silently changes behavior if you remove the type signature.
foo :: (Arrow a, ToPredefinedStr (b -> c)) => (b -> c) -> a b (c, String)
foo f = appMyArr (myArr f)