I'm having trouble understanding why there are two independent f and f0 Applicative constraints in code below (requires reducers package).
import Data.Semigroup.Applicative
import Data.Semigroup.Reducer
import Data.Semigroup
-- | Foo
--
-- >>> getMax $ foo ["abc","a","hello",""]
-- 5
foo :: [String] -> (Max Int)
foo = foldReduce . map (length)
bar :: (Foldable f, Monoid m, Reducer e m) => f e -> m
bar = foldReduce
m :: Max Int
m = unit (2 :: Int)
apm :: (Applicative f) => Ap f (Max Int)
apm = unit $ pure (2 :: Int) -- ambiguous Applicative!
I think that I need to somehow tell that I want f0 ~ f where f0 is independently inferred by use of pure.
I tried to simplify:
u :: (Applicative f, Monoid m) => e -> Ap f m
u = undefined
m :: (Applicative f) => Ap f (Max Int)
m = u $ (pure (2 :: Int))
It will compile once e is changed to f e so that contexts can "unify". But I don't know how to unify with reducer context.
My goal is to foldReduce with Applicative Semigroup (if that's possible at all) so that length will be replaced with effectful version.
The standard solution is to use ScopedTypeVariables to announce that the f in the signature for apm and the f you want pure to produce are the same f. So:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Semigroup.Applicative
import Data.Semigroup.Reducer
import Data.Semigroup
apm :: forall f. Applicative f => Ap f (Max Int)
apm = unit (pure 2 :: f Int)
Don't lose the forall; it's a requirement of the extension to bring f into scope in the definition's body.
Related
I can write an instance
-- In Data.Sequence.Internal
instance Lift a => Lift (Seq a) where
...
letting users lift fully realized sequences into splices. But suppose I want something a bit different, to build functions for creating sequences?
sequenceCode :: Quote m => Seq (Code m a) -> Code m (Seq a)
sequenceCode = ???
The idea would be that I'd be able to write something like
triple :: a -> a -> a -> Seq a
triple a b c = $$(sequenceCode (fromList [[|| a ||], [|| b ||], [|| c ||]]))
and have that function build its sequence directly with the underlying sequence constructors, rather than having to build and convert a list at run-time.
It's not very hard to write something like sequenceCode directly for sequences, using their internals (look below the jump). But, as the name suggests, sequenceCode looks a lot like sequence. Is there a way to generalize it? A moment's reflection shows that Traversable is insufficient. Would it be possible to do something with the Generic1 class in staged generics? I made a few attempts, but I don't understand that package well enough to know the right place to start. Would it be possible even just using plain old GHC generics? I'm beginning to suspect so, but I haven't tried yet and it will surely be hairy.
Here's the code for a Data.Sequence version:
{-# language TemplateHaskellQuotes #-}
import Data.Sequence.Internal
import qualified Language.Haskell.TH.Syntax as TH
class Functor t => SequenceCode t where
traverseCode :: TH.Quote m => (a -> TH.Code m b) -> t a -> TH.Code m (t b)
traverseCode f = sequenceCode . fmap f
sequenceCode :: TH.Quote m => t (TH.Code m a) -> TH.Code m (t a)
sequenceCode = traverseCode id
instance SequenceCode Seq where
sequenceCode (Seq t) = [|| Seq $$(traverseCode sequenceCode t) ||]
instance SequenceCode Elem where
sequenceCode (Elem t) = [|| Elem $$t ||]
instance SequenceCode FingerTree where
sequenceCode (Deep s pr m sf) =
[|| Deep s $$(sequenceCode pr) $$(traverseCode sequenceCode m) $$(sequenceCode sf) ||]
sequenceCode (Single a) = [|| Single $$a ||]
sequenceCode EmptyT = [|| EmptyT ||]
instance SequenceCode Digit where
sequenceCode (One a) = [|| One $$a ||]
sequenceCode (Two a b) = [|| Two $$a $$b ||]
sequenceCode (Three a b c) = [|| Three $$a $$b $$c ||]
sequenceCode (Four a b c d) = [|| Four $$a $$b $$c $$d ||]
instance SequenceCode Node where
sequenceCode (Node2 s x y) = [|| Node2 s $$x $$y ||]
sequenceCode (Node3 s x y z) = [|| Node3 s $$x $$y $$z ||]
Then in another module, we can define triple as above:
triple :: a -> a -> a -> Seq a
triple a b c = $$(sequenceCode (fromList [[|| a ||], [|| b ||], [|| c ||]]))
When I compile this with -ddump-splices (or -ddump-ds), I can verify that the sequence is built directly rather than using fromList.
I've uploaded a package that does this.
It turns out that GHC.Generics is sufficient. However, I will actually use linear-generics instead, because it has a more general version of Generic1. The idea is that by examining the generic representation of a value, we can build up all the information we need to produce a Template Haskell code for it. It's all quite low-level! First, some throat-clearing:
{-# language TemplateHaskellQuotes #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds #-}
{-# language TypeOperators #-}
{-# language EmptyCase #-}
{-# language DefaultSignatures #-}
module Language.Haskell.TH.TraverseCode
( TraverseCode (..)
, sequenceCode
, genericTraverseCode
, genericSequenceCode
) where
import Generics.Linear
import Language.Haskell.TH.Syntax
(Code, Lift (..), Exp (..), Quote, Name)
import qualified Language.Haskell.TH.Syntax as TH
import Language.Haskell.TH.Lib (conE)
import Data.Kind (Type)
-- for instances
import qualified Data.Functor.Product as FProd
import qualified Data.Functor.Sum as FSum
import Data.Functor.Identity
import qualified Data.Sequence.Internal as Seq
import Data.Coerce
Now we'll get into the meat of things:
class TraverseCode t where
traverseCode :: Quote m => (a -> Code m b) -> t a -> Code m (t b)
default traverseCode
:: (Quote m, GTraverseCode (Rep1 t), Generic1 t)
=> (a -> Code m b) -> t a -> Code m (t b)
traverseCode = genericTraverseCode
sequenceCode
:: (TraverseCode t, Quote m)
=> t (Code m a) -> Code m (t a)
sequenceCode = traverseCode id
genericSequenceCode
:: (Quote m, GTraverseCode (Rep1 t), Generic1 t)
=> t (Code m a) -> Code m (t a)
genericSequenceCode = TH.unsafeCodeCoerce . gtraverseCode id . from1
genericTraverseCode
:: (Quote m, GTraverseCode (Rep1 t), Generic1 t)
=> (a -> Code m b) -> t a -> Code m (t b)
genericTraverseCode f = TH.unsafeCodeCoerce . gtraverseCode f . from1
class GTraverseCode f where
gtraverseCode :: Quote m => (a -> Code m b) -> f a -> m Exp
Why do we use untyped Template Haskell here? Simple: it's pretty easy to build the expressions we need, but working out how to make types useful for the sub-expressions would be tricky. So then, of course, we need generic instances. We'll work our way down step by step, from the outside in, gathering info along the way.
First we look at the type stuff:
instance (Datatype c, GTraverseCodeCon f)
=> GTraverseCode (D1 c f) where
gtraverseCode f m#(M1 x) = gtraverseCodeCon pkg modl f x
where
pkg = packageName m
modl = moduleName m
This gets us the names GHC uses for the package and module.
Next we look at the constructor stuff:
class GTraverseCodeCon f where
gtraverseCodeCon :: Quote m => String -> String -> (a -> Code m b) -> f a -> m Exp
instance GTraverseCodeCon V1 where
gtraverseCodeCon _pkg _modl _f x = case x of
instance (GTraverseCodeCon f, GTraverseCodeCon g)
=> GTraverseCodeCon (f :+: g) where
gtraverseCodeCon pkg modl f (L1 x) = gtraverseCodeCon pkg modl f x
gtraverseCodeCon pkg modl f (R1 y) = gtraverseCodeCon pkg modl f y
instance (Constructor c, GTraverseCodeFields f)
=> GTraverseCodeCon (C1 c f) where
gtraverseCodeCon pkg modl f m#(M1 x) = gtraverseCodeFields (conE conN) f x
where
conBase = conName m
conN :: Name
conN = TH.mkNameG_d pkg modl conBase
The interesting case is when we reach an actual constructor (C1). Here we grab the (unqualified) name of the constructor from the Constructor instance, and combine it with the package and module names to get the Template Haskell Name of the constructor, from which we can build an expression referring to it. This expression gets passed on down to the lowest level, where we deal with fields. The rest is basically a left fold over those fields.
class GTraverseCodeFields f where
gtraverseCodeFields :: Quote m => m Exp -> (a -> Code m b) -> f a -> m Exp
instance GTraverseCodeFields f => GTraverseCodeFields (S1 c f) where
gtraverseCodeFields c f (M1 x) = gtraverseCodeFields c f x
instance (GTraverseCodeFields f, GTraverseCodeFields g)
=> GTraverseCodeFields (f :*: g) where
gtraverseCodeFields c f (x :*: y) =
gtraverseCodeFields (gtraverseCodeFields c f x) f y
instance Lift p => GTraverseCodeFields (K1 i p) where
gtraverseCodeFields c _f (K1 x) = [| $c x |]
instance GTraverseCodeFields Par1 where
gtraverseCodeFields cc f (Par1 ca) =
[| $cc $(TH.unTypeCode (f ca)) |]
instance GTraverseCodeFields U1 where
gtraverseCodeFields cc _f U1 = cc
-- Note: this instance is *different* from the one that we'd
-- write if we were using GHC.Generics, because composition works
-- differently in Generics.Linear.
instance (GTraverseCodeFields f, TraverseCode g) => GTraverseCodeFields (f :.: g) where
gtraverseCodeFields cc f (Comp1 x) =
gtraverseCodeFields cc (traverseCode f) x
Now we can write all sorts of instances:
instance TraverseCode Maybe
instance TraverseCode Identity
instance TraverseCode []
instance TH.Lift a => TraverseCode (Either a)
instance TH.Lift a => TraverseCode ((,) a)
instance (TraverseCode f, TraverseCode g)
=> TraverseCode (FProd.Product f g)
instance (TraverseCode f, TraverseCode g)
=> TraverseCode (FSum.Sum f g)
instance TraverseCode V1
-- The Elem instance isn't needed for the Seq instance
instance TraverseCode Seq.Elem
instance TraverseCode Seq.Digit
instance TraverseCode Seq.Node
instance TraverseCode Seq.FingerTree
For the Seq instance I was after, we need to write something by hand, because Seq isn't an instance of Generic1 (and we don't want it to be). Additionally, we don't really want the derived instance. Using a bit of coercion magic, and knowing a little something about how zipWith and replicate work on sequences, we can minimize the size of the splice and the number of types GHC has to deal with once it's compiled to Core.
instance TraverseCode Seq.Seq where
-- Stick a single coercion on the outside, instead of having a bunch
-- of `Elem` constructors on the inside.
traverseCode f s = [|| coerceFT $$(traverseCode f ft') ||]
where
-- Use zipWith to make the tree representing the sequence
-- nice and shallow.
ft' = coerceSeq (Seq.zipWith (flip const) (Seq.replicate (Seq.length s) ()) s)
coerceFT :: Seq.FingerTree a -> Seq.Seq a
coerceFT = coerce
coerceSeq :: Seq.Seq a -> Seq.FingerTree a
coerceSeq = coerce
I want to define deeply nested compositions of applicative functors. For example something like this:
{-# LANGUAGE TypeOperators #-}
import Control.Monad.Trans.Cont
import Control.Arrow (Kleisli (..))
import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Compose
import Data.Functor
type Configurator = Kleisli Parser Value
type Allocator = ContT () IO
type Validator = Either String
someConfigurator :: Configurator Int
someConfigurator = undefined
someAllocator :: Allocator Char
someAllocator = undefined
-- the nested functor composition. left-associated
type Phases = Configurator `Compose` Allocator `Compose` Validator
data Foo = Foo Int Char
-- I want to streamline writing this, without spamming the Compose constructor
fooPhases :: Phases Foo
fooPhases = _
To streamline the syntax for creating the fooPhases value, I though of (ab)using QualifiedDo:
module Bind where
import Data.Functor
import Data.Functor.Compose
(>>=) :: Functor f => f a -> (a -> g b) -> Compose f g b
(>>=) f k = bindPhase f k
(>>) :: Functor f => f a -> g b -> Compose f g b
(>>) f g = Compose $ f <&> \_ -> g
fail :: MonadFail m => String -> m a
fail = Prelude.fail
bindPhase :: Functor f => f a -> (a -> g b) -> Compose f g b
bindPhase f k = Compose (f <&> k)
Somewhat to my surprise, it worked:
{-# LANGUAGE QualifiedDo #-}
import qualified Bind
fooPhases :: Phases Foo
fooPhases = Bind.do
i <- someConfigurator
c <- someAllocator
pure (Foo i c)
Alas, when I add applicative-like functions to the Bind module
return :: Applicative f => a -> f a
return = Prelude.pure
pure :: Applicative f => a -> f a
pure = Prelude.pure
fmap :: Functor f => (a -> b) -> f a -> f b
fmap = Prelude.fmap
join :: f (g a) -> Compose f g a
join = Compose
(<*>) :: (Applicative f, Applicative g) => f (a -> b) -> g a -> Compose f g b
(<*>) f g = Compose $ f <&> \z -> Prelude.fmap (z $) g
and then enable ApplicativeDo in Main, I start to get errors like the following:
* Couldn't match type: Compose (Kleisli Parser Value) (ContT () IO)
with: Kleisli Parser Value
Expected: Configurator (Compose Allocator Validator Foo)
Actual: Compose
(Kleisli Parser Value)
(ContT () IO)
(Compose Allocator Validator Foo)
Is there a way to use my Bind.do when both QualifiedDo and ApplicativeDo are enabled in Main?
To make this easier to reason about, first manually desugar fooPhases each way:
fooPhasesMonad =
someConfigurator Bind.>>= \i ->
someAllocator Bind.>>= \c ->
pure (Foo i c)
fooPhasesApplicative = Bind.fmap Foo someConfigurator Bind.<*> someAllocator
If you check their types in GHCi, you'll see that fooPhasesMonad has the type you want (as expected, since it works), but fooPhasesApplicative has type (Configurator `Compose` Allocator) Foo.
The first problem is that Bind.fmap f m isn't equivalent to m Bind.>>= (pure . f). In particular, the latter produces an extra layer of Compose but the former does not. When you use ApplicativeDo, using the former instead means you end up with just (Configurator `Compose` Allocator) instead of (Configurator `Compose` Allocator `Compose` Validator), which is the cause of your type error. To fix it, replace your definition of Bind.fmap with this one:
fmap :: (Functor f, Applicative g) => (a -> b) -> f a -> Compose f g b
fmap f k = bindPhase k (Prelude.pure . f)
The "monads" of your do-notation fail all of the monad laws, though (even the types of the results can't be right), so some rewrites that you take for granted aren't still valid. In particular, you'll still get an error unless you settle for your types being composed like this instead:
type Phases = (Configurator `Compose` Validator) `Compose` Allocator
I'm solving some ploblem on generating ancestor instances in Haskell. Recently I found this on Haskell wiki: Class system extension proposal. So, I would like to know, are there any solutions for this proposal already?
Here are the examples from the Proposal:
The current class system in Haskell is based on the idea that you can
often provide default implementations for class methods at the same
time as defining the class, by using other methods of the class or its
ancestors. However consider the following hierarchy, adapted from
Functor hierarchy proposal and The Other Prelude:
class Functor m where
fmap :: (a -> b) -> m a -> m b
class Functor m => Applicative m where
return :: a -> m a
apply :: m (a -> b) -> m a -> m b
(>>) :: m a -> m b -> m b
ma >> mb = (fmap (const id) ma) `apply` mb
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
For all concrete instances of Monad we can define fmap, apply, and
(>>)in terms of return and (>>=) as follows:
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
In other words, we'd like to be able to write:
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
and be able to define new instances of Monad just by supplying
definitions for return and (>>=) by writing:
instance Monad T where
ma >>= a_mb = ... -- some definition
return a = ... -- some definition
Explicit import/export of instances
This is needed so that large programs can be built without fear of
colliding instance declarations between different packages. A possible
syntax could be:
module M
-- exported instances
( instance Monad T
, instance Functor (F a) hiding (Functor (F Int), Functor (F Char))
, F(..)
) where
import Foo (instance Monad a hiding Monad Maybe)
data T a
data F a b
where the context is elided because this isn't used in instance
selection (at the moment). The import directive tells the compiler to
use all Monad instances exported by Foo except for the Monad Maybe
instance (it doesn't matter whether or not Foo actually does export a
Monad Maybe instance - all that matters here is that we don't want it
if there is one).
Yes, the DefaultSignatures extension allows this. For example, for the Functor/Applicative example, one could write
{-# LANGUAGE DefaultSignatures #-}
class Functor f where
fmap :: (a -> b) -> f a -> f b
default fmap :: Applicative f => (a -> b) -> f a -> f b
fmap = liftA
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
I'm not the biggest fan of varargs, but I always thought both the applicative (f <$> x <*> y) and idiom ([i| f x y |]) styles have too many symbols. I usually prefer going the liftA2 f x y way, but I, too, think that A2 is a little ugly. From this question, I've learned it is possible to implement vararg functions in Haskell. This way, is it possible to use the same principle in order implement a lift function, such that:
lift f a b == pure f <*> a <*> b
I've tried replacing the + by <*> on the quoted code:
class Lift r where
lift :: a -> r
instance Lift a where
lift = id
instance (Lift r) => Lift (a -> r) where
lift x y = lift (x <*> y)
But I couldn't manage to get the types right...
Notice that you can chain any number of <*>, to get a function of the form
f (a0 -> .. -> an) -> (f a0 -> .. -> f an)
If we have the type a0 -> .. -> an and f a0 -> .. -> f an, we can compute f from this. We can encode this relation, and the most general type, as follows
class Lift a f b | a b -> f where
lift' :: f a -> b
As you may expect, the "recursive case" instance will simply apply <*> once, then recurse:
instance (a ~ a', f' ~ f, Lift as f rs, Applicative f)
=> Lift (a -> as) f (f' a' -> rs) where
lift' f a = lift' $ f <*> a
The base case is when there is no more function. Since you can't actually assert "a is not a function type", this relies on overlapping instances:
instance (f a ~ b) => Lift a f b where
lift' = id
Because of GHCs instance selection rules, the recursive case will always be selected, if possible.
Then the function you want is lift' . pure :
lift :: (Lift a f b, Applicative f) => a -> b
lift x = lift' (pure x)
This is where the functional dependency on Lift becomes very important. Since f is mentioned only in the context, this function would be ill-typed unless we can determine what f is knowing only a and b (which do appear in the right hand side of =>).
This requires several extensions:
{-# LANGUAGE
OverlappingInstances
, MultiParamTypeClasses
, UndecidableInstances
, FunctionalDependencies
, ScopedTypeVariables
, TypeFamilies
, FlexibleInstances
#-}
and, as usual with variadic functions in Haskell, normally the only way to select an instance is to give an explicit type signature.
lift (\x y z -> x * y + z) readLn readLn readLn :: IO Int
The way I have written it, GHC will happily accept lift which is polymorphic in the arguments to f (but not f itself).
lift (+) [1..5] [3..5] :: (Enum a, Num a) => [a]
Sometimes the context is sufficient to infer the correct type. Note that the argument type is again polymorphic.
main = lift (\x y z -> x * y + z) readLn readLn readLn >>= print
As of GHC >= 7.10, OverlappingInstances has been deprecated and the compiler will issue a warning. It will likely be removed in some later version. This can be fixed by removing OverlappingInstances from the {-# LANGUAGE .. #-} pragma and changing the 2nd instance to
instance {-# OVERLAPS #-} (f a ~ b) => Lift a f b where
I assume you would prefer to use lift without type annotations. In this case there are basically two options:
First, if we use OverlappingInstances, polymorphic functions need annotations:
{-# LANGUAGE
OverlappingInstances,
MultiParamTypeClasses,
UndecidableInstances,
FunctionalDependencies,
FlexibleInstances,
TypeFamilies
#-}
import Control.Applicative
class Applicative f => ApN f a b | a b -> f where
apN :: f a -> b
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
instance (Applicative f, ApN f a' b', b ~ (f a -> b')) => ApN f (a -> a') b where
apN f fa = apN (f <*> fa)
lift :: ApN f a b => a -> b
lift a = apN (pure a)
-- Now we can't write "lift (+) (Just 0) Nothing"
-- We must annotate as follows:
-- lift ((+) :: Int -> Int -> Int) (Just 0) Nothing
-- Monomorphic functions work fine though:
-- lift (||) (Just True) (Just True) --> results in "Just True"
Second, if we instead use IncoherentInstances, lift will work without annotations even on polymorphic functions. However, some complicated stuff still won't check out, for example (lift . lift) (+) (Just (Just 0)) Nothing.
{-# LANGUAGE
IncoherentInstances, MultiParamTypeClasses,
UndecidableInstances,ScopedTypeVariables,
AllowAmbiguousTypes, FlexibleInstances, TypeFamilies
#-}
import Control.Applicative
class Applicative f => ApN f a b where
apN :: f a -> b
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
instance (Applicative f, ApN f a' b', b ~ (f a -> b')) => ApN f (a -> a') b where
apN f fa = apN (f <*> fa)
lift :: forall f a b. ApN f a b => a -> b
lift a = (apN :: f a -> b) (pure a)
-- now "lift (+) (Just 0) (Just 10)" works out of the box
I presented two solutions instead of just the one with IncoherentInstances because IncoherentInstances is a rather crude extension that should be avoided if possible. It's probably fine here, but I thought it worthwhile to provide an alternative solution, anyway.
In both cases I use the same trick to help inference and reduce annotations: I try to move information from the instance heads to the instance constraints. So instead of
instance (Applicative f) => ApN f a (f a) where
apN = id
I write
instance (Applicative f, b ~ f a) => ApN f a b where
apN = id
Also, in the other instance I use a plain b parameter in the instance head and add b ~ (f a ~ b') to the constraints.
The reason for doing this is that GHC first checks if there is a matching instance head, and it tries to resolve the constraints only after there is a successful match. We want to place the least amount of burden on the instance head, and let the constraint solver sort things out (because it's more flexible, can delay making judgements and can use constraints from other parts of the program).