Quickcheck Applicative homomorphism law for Binary Tree - haskell

I am aware that the following question exists:
haskell - How to quickcheck applicative homomorphism property? - Stack Overflow
However, the introduction of the following PRAGMA
{-# LANGUAGE ScopedTypeVariables #-}
didn't solve my issue.
These are my definitions:
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Laws where
import Control.Applicative ((<$>), liftA3)
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Gen
data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving (Show, Eq)
instance Functor BinTree where
fmap _ Empty = Empty
fmap f (Node x hi hd) = Node (f x) (fmap f hi) (fmap f hd)
instance Applicative BinTree where
-- pure :: a -> BinTree a
pure x = Node x (pure x) (pure x)
-- <*> :: BinTree (a -> b) -> BinTree a -> BinTree b
_ <*> Empty = Empty -- L1,
Empty <*> t = Empty
(Node f l r) <*> (Node x l' r') = Node (f x) (l <*> l') (r <*> r')
instance (Arbitrary a) => Arbitrary (BinTree a) where
arbitrary = oneof [return Empty, -- oneof :: [Gen a] -> Gen a
liftA3 Node arbitrary arbitrary arbitrary]
-- Identity
apIdentityProp :: (Applicative f, Eq (f a)) => f a -> Bool
apIdentityProp v = (pure id <*> v) == v
-- pure f <*> pure x = pure (f x) -- Homomorphism
apHomomorphismProp :: forall f a b. (Applicative f, Eq (f b)) => Fun a b -> a -> Bool
apHomomorphismProp (apply -> g) x = (((pure g :: f (a -> b)) <*> (pure x :: f a)) :: f b) == (pure (g x) :: f b)
main :: IO ()
main = quickCheck (apHomomorphismProp :: Fun Int Int -> Int -> Bool)
How can I fix the following error ?
Could not deduce (Applicative f0)
from the context: (Applicative f, Eq (f b))

It would have been easier to analyse the problem if you had included the full error message, which mentions an ambiguous type variable. The thing that GHC is complaining about is that f does not appear anywhere in the type signature of apHomomorphismProp, except in the quantifier and constraints.
Why is that a problem? Well, it isn't a problem... but it used to be in older Haskell versions, because there was no way for the compiler to tell when you're using apHomomorphismProp what applicative it's supposed to test here. In fact this is still the case with the way you are using it: apHomomorphismProp :: Fun Int Int -> Int -> Bool does not mention BinTree in any way, so how is the compiler supposed to know that's what you mean? For all it knows, you could as well be asking for, say, the Maybe applicative to be tested here.
The solution, in modern Haskell, is -XTypeApplications, which just lets you explicitly say what a type variable should be instantiated with.
{-# LANGUAGE TypeApplications #-}
main = quickCheck (apHomomorphismProp #BinTree :: Fun Int Int -> Int -> Bool)
In fact I would recommend also using this syntax to clarify the Int types:
main = quickCheck $ apHomomorphismProp #BinTree #Int #Int
However, there was still the compiler error with apHomomorphismProp, which is all because prior to TypeApplications, a signature like the one you gave to apHomomorphismProp was useless. But this restriction is now obsolete†, and it can be disabled with -XAllowAmbiguousTypes:
{-# LANGUAGE ScopedTypeVariables, UnicodeSyntax, AllowAmbiguousTypes, TypeApplications #-}
apHomomorphismProp :: ∀ f a b. (Applicative f, Eq (f b)) => Fun a b -> a -> Bool
apHomomorphismProp (apply -> g) x = (pure #f g <*> pure x) == pure (g x)
Note that I only need to mention #f for one of the pures, the other ones are automatically constrained to the same applicative.
†It's arguable whether it's really obsolete. What's probably still true is that if a beginner gives their function an ambiguous type, it's more likely a mistake that should be caught right there and then, rather than something that's actually intended for use with -XTypeApplications. An unintentionally ambiguous type can cause quite confusing errors further down the line.

Related

How to test Monad instance for custom StateT?

I'm learning Monad Transformers, and one of the exercises asks to implement the Monad instance for StateT.
I want to test that my implementation admits to the Monad laws using the validity package, which is like the checkers package.
Problem is, my Arbitrary instance doesn't compile. I saw this question, but it doesn't quite do what I want because the test basically duplicates the implementation and doesn't check the laws.
There's also this question, but it's unanswered, and I've already figured out how to test Monad Transformers not involving functions (like MaybeT).
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE InstanceSigs #-}
module Ch11.MonadT (StT (..)) where
import Control.Monad.Trans.State (StateT (..))
newtype StT s m a = StT (s -> m (a, s))
deriving
(Functor, Applicative)
via StateT s m
instance (Monad m) => Monad (StT s m) where
return :: a -> StT s m a
return = pure
(>>=) :: StT s m a -> (a -> StT s m b) -> StT s m b
StT x >>= f = StT $ \s -> do
(k, s') <- x s
let StT y = f k
y s'
(>>) :: StT s m a -> StT s m b -> StT s m b
(>>) = (*>)
My test:
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
module Ch11.MonadTSpec (spec) where
import Ch11.MonadT (StT (..))
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Monad
spec :: Spec
spec = do
monadSpecOnArbitrary #(StTArbit Int [] Int)
-- create wrapper to avoid orphan instance error
newtype StTArbit s m a = StTArbit (StT s m a)
deriving
(Functor, Applicative, Monad)
instance (Arbitrary s, Function s, Arbitrary1 m, Arbitrary a) => Arbitrary (StTArbit s m a) where
arbitrary = do
f <- arbitrary :: Fun s (m (a, s))
StTArbit . StT <$> f
Error:
• Couldn't match type: (a0, s0)
with: s -> m (a, s)
Expected: Gen (s -> m (a, s))
Actual: Gen (a0, s0)
• In the second argument of ‘(<$>)’, namely ‘f’
In a stmt of a 'do' block: StTArbit . StT <$> f
OP here, this is what I ended up doing.
-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/explicit_forall.html
{-# LANGUAGE ExplicitForAll #-}
-- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html
{-# LANGUAGE TypeApplications #-}
module Ch11.MonadTSpec (spec) where
import Ch11.MonadT (StT (..), runStT)
import Data.Function as F
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
spec :: Spec
spec = do
describe "Monad (StT Int [])" $ do
describe "satisfies Monad laws" $ do
-- the types are in the same order as in `forall`
prop "right identity law" (prop_monadRightId #Int #Int #[])
prop "left identity law" (prop_monadLeftId #Int #Int #Int #[])
prop "associative law" (prop_monadAssoc #Int #Int #Int #Int #[])
{- HLINT ignore -}
{-
the types in `forall` are specified in the order of dependency.
since `m` needs `a` and `s`, those appear before `m` in the list.
-}
-- (x >>= return) == x
prop_monadRightId ::
forall a s m.
(Monad m, Eq (m (a, s)), Show (m (a, s))) =>
s ->
Fun s (m (a, s)) ->
Property
prop_monadRightId s f = ((===) `F.on` go) (m >>= return) m
where
m = StT $ applyFun f
go st = runStT st s
-- (return x >>= f) == (f x)
prop_monadLeftId ::
forall a b s m.
(Monad m, Eq (m (b, s)), Show (m (b, s))) =>
a ->
s ->
Fun (a, s) (m (b, s)) ->
Property
prop_monadLeftId a s f = ((===) `F.on` go) (return a >>= h) m
where
g = applyFun2 f
m = StT $ g a
h = StT . g
go st = runStT st s
-- ((x >>= f) >>= g) == (x >>= (\x' -> f x' >>= g))
prop_monadAssoc ::
forall a b c s m.
(Monad m, Eq (m (b, s)), Show (m (b, s)), Eq (m (c, s)), Show (m (c, s))) =>
s ->
Fun s (m (a, s)) ->
Fun (a, s) (m (b, s)) ->
Fun (b, s) (m (c, s)) ->
Property
prop_monadAssoc s h f g =
((===) `F.on` go)
((m >>= f') >>= g')
(m >>= (\x -> f' x >>= g'))
where
m = StT $ applyFun h
f' = StT . applyFun2 f
g' = StT . applyFun2 g
go st = runStT st s
I think you want pure, not (<$>). (But I haven't checked with my local compiler, so I'm not sure.) You probably also have to turn your Fun into an actual function.
arbitrary = do
f <- arbitrary
pure (StTArbit . StT . applyFun $ f)
I'd also point out that there's not much point to making a newtype here. I guess it avoids an orphan instance warning? But you've defined the type you're writing an instance for yourself, presumably even in the same package, so it seems pretty benign; if it's part of a separate cabal component that people can't depend on, like a test suite, even more so.

QuickCheck returns "0 tests" when checking Applicative homomorphism property (Binary Tree)

I would like to check that homomorphism Applicative law holds for datatype BinTree:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Laws where
import Control.Applicative ((<$>), liftA3)
import Data.Monoid
import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Gen
data BinTree a = Empty | Node a (BinTree a) (BinTree a) deriving (Show, Eq)
instance Functor BinTree where
fmap _ Empty = Empty
fmap f (Node x hi hd) = Node (f x) (fmap f hi) (fmap f hd)
instance Applicative BinTree where
-- pure :: a -> BinTree a
pure x = Node x (pure x) (pure x)
-- <*> :: BinTree (a -> b) -> BinTree a -> BinTree b
_ <*> Empty = Empty -- L1,
Empty <*> t = Empty
(Node f l r) <*> (Node x l' r') = Node (f x) (l <*> l') (r <*> r')
instance (Arbitrary a) => Arbitrary (BinTree a) where
arbitrary = oneof [return Empty, -- oneof :: [Gen a] -> Gen a
liftA3 Node arbitrary arbitrary arbitrary]
-- Identity
apIdentityProp :: (Applicative f, Eq (f a)) => f a -> Bool
apIdentityProp v = (pure id <*> v) == v
apHomomorphismProp :: forall f a b. (Applicative f, Eq (f b)) => Fun a b -> a -> Bool
apHomomorphismProp (apply -> g) x = (pure #f g <*> pure x) == pure (g x)
main = quickCheck $ apHomomorphismProp #BinTree #Int #Int
However, when I execute the code, quickCheck applied to the applicative property returns:
(0 tests)
How can I solve this issue ?
Quite simply, your pure implementation generates an infinite tree. <*> preserves the infinite size of the trees on both of its sides. Then you compare the resulting infinite tree for equality with another infinite tree.
Well, it evidently doesn't find any discrepancy between them... but it doesn't terminate either. So QuickCheck never actually manages to confirm even one test case correct.
One way out could be to use not == but an equality operator which only checks for equality down to a limited depth, and assumes it'll be equal further down as well. (Note that it will still be exponentially expensive, so you can't even go to very great depth!)

How do I map over parameters?

Given the type X = X Int Int, I want to define a function toX :: [String] -> X which constructs an X during runtime with generics.
This is easy when I just write it down like this:
toX :: [String] -> X
toX (x:[y]) = to (M1 (M1 (M1 (K1 $ read x) :*: (M1 (K1 $ read y)))))
But I don't know how to do it recursive (in case we have a lot more than two parameters). My first try was something like this:
toX xs = to (M1 (M1 (toX' xs)))
toX' (x:[]) = M1 (K1 x)
toX' (x:xs) = M1 (K1 x) :*: (toX' xs)
which (of course) fails with a type error. Looking at the type of (:*:) confuses me even more: (:*:) :: f p -> g p -> (:*:) f g p. I have absolutely no idea what this type is supposed to mean and how to proceed from here.
Any hints?
#!/usr/bin/env stack
{- stack --resolver lts-8.4 runghc-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
data X = X Int Int deriving (Generic, Show)
main :: IO ()
main = do
print $ toXeasy ["2","4"]
-- print $ toX ["2","4"]
toXeasy :: [String] -> X
toXeasy (x:[y]) = to (M1 (M1 (M1 (K1 $ read x) :*: (M1 (K1 $ read y)))))
--toX :: [String] -> X
--toX xs = to (M1 (M1 (toX' xs)))
--toX' (x:[]) = M1 (K1 x)
--toX' (x:xs) = M1 (K1 x) :*: (toX' xs)
This defines a function readFields :: [String] -> Maybe X for any Generic data type X which has only one constructor (with at least one field).
readFields is defined using a generic version gReadFields which works with generic representations (i.e., types constructed using type constructors that appear in GHC.Generics: M1, (:*:), K1...).
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
module A where
import GHC.Generics
import Control.Monad.Trans.State
import Text.Read
data X = X Int Int deriving (Generic, Show)
main = print (readFields ["14", "41"] :: Maybe X)
readFields :: (Generic a, GReadableFields (Rep a)) => [String] -> Maybe a
readFields xs = fmap to (evalStateT gReadFields xs)
class GReadableFields f where
gReadFields :: StateT [String] Maybe (f p)
instance GReadableFields f => GReadableFields (M1 i c f) where
gReadFields = fmap M1 gReadFields
-- When your type is a large product, you cannot assume that
-- the generic product structure formed using `(:*:)` is list-
-- like (field1 :*: (field2 :*: (field3 ...)), so it is not
-- clear how to split the input list of strings to read each
-- component. For that reason we use `State`. Another possible way
-- is to compute the number of fields of the two operands `f` and `g`.
instance (GReadableFields f, GReadableFields g) => GReadableFields (f :*: g) where
gReadFields = do
f <- gReadFields
g <- gReadFields
return (f :*: g)
instance Read c => GReadableFields (K1 i c) where
gReadFields = StateT $ \(x : xs) -> do
c <- readMaybe x
return (K1 c, xs)
Just for fun, here is a way of achieving a similar results which does not use generics. The user has to provide a constructor (or a function), and a type class takes care of filling all its arguments with values read from the list of strings.
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
module A where
data X = X Int Int deriving Show
main = print (readFields X ["14", "41"])
type family Result a where
Result (a -> b) = Result b
Result a = a
class ReadableFields a where
readFields :: a -> [String] -> Maybe (Result a)
instance {-# OVERLAPPING #-} (ReadableFields b, Read a) => ReadableFields (a -> b) where
readFields f (x : xs) = do
a <- readMaybe x
readFields (f a) xs
readFields _ _ = Nothing
instance (Result a ~ a) => ReadableFields a where
readFields a _ = Just a
EDIT
That use of Generic is straightforward enough that the underlying pattern is packaged in one-liner.
{-# LANGUAGE FlexibleContexts #-}
import Generics.OneLiner
import Control.Monad.Trans.State
import Text.Read
Define an action to read a single field. It is important that there is an instance Applicative (StateT [String] Maybe) so that it can be composed.
-- Takes a string from the state and reads it out.
readM :: Read a => StateT [String] Maybe a
readM = StateT readM'
where
readM' (x : xs) | Just a <- readMaybe x = Just (a, xs)
readM' _ = Nothing
This is now a one-liner, using createA from the one-liner library.
readFields xs = evalStateT (createA (For :: For Read) readM) xs
main = print (readFields ["14", "42"] :: Maybe (Int, Int))
Here is a solution using generics-sop:
{-# LANGUAGE DataKinds, TypeFamilies, FlexibleContexts, TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
module ReadFields where
import Data.Maybe
import Generics.SOP
import Generics.SOP.TH
readFields ::
(Generic a, Code a ~ '[ xs ], All Read xs) => [String] -> Maybe a
readFields xs =
to . SOP . Z . hcmap (Proxy #Read) (I . read . unK) <$> fromList xs
data X = X Int Int
deriving Show
deriveGeneric ''X
Testing:
GHCi> readFields #X ["3", "4"]
Just (X 3 4)
GHCi> readFields #X ["3"]
Nothing

Why there is no way to derive Applicative Functors in Haskell?

In Haskell, you can derive Functor, Foldable and Traversable automatically using deriving. There is no way to derive Applicative, though. Considering there is one obvious way to define an Applicative instance (which would amount to a zipped application), isn't there any way to enable deriving Applicative?
No, this is not obvious at all. Compare the following Applicative instances:
[]
ZipList
Data.Sequence.Seq, whose Applicative instance declaration runs to several hundred lines.
IO
(->) r
Parsers in parsec, attoparsec, regex-applicative.
Proxy in the pipes package.
There very little uniformity here, and most of the instances are non-obvious.
As David Young comments, the [] and ZipList instances "are both, ultimately, two different, equally valid Applicative instances for the list type."
Now that DerivingVia has been released (GHC-8.6 or newer) it is actually possible to derive Applicative with the help of DeriveGeneric for any deterministic data type! That is to say, any data type with exactly one variant:
data Foo x = Foo x | Fe -- This is non-deterministic and can't derive Applicative
data Bar x = Bar x x (Bar x) -- This is deterministic and can derive Applicative
data Baz x = Baz (Either Int x) [x] -- This is also ok, since [] and Either Int
-- are both Applicative
data Void x -- This is not ok, since pure would be impossible to define.
To derive Applicative, we first need to define a wrapper for deriving via generics:
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Generically1 where
import GHC.Generics
newtype Generically1 f x = Generically1 { generically1 :: f x }
fromg1 :: Generic1 f => Generically1 f a -> Rep1 f a
fromg1 = from1 . generically1
tog1 :: Generic1 f => Rep1 f x -> Generically1 f x
tog1 = Generically1 . to1
instance (Functor f, Generic1 f, Functor (Rep1 f))
=> Functor (Generically1 f) where
fmap f (Generically1 x) = Generically1 $ fmap f x
instance (Functor f, Generic1 f, Applicative (Rep1 f))
=> Applicative (Generically1 f) where
pure = tog1 . pure
f <*> x = tog1 $ fromg1 f <*> fromg1 x
instance (Functor f, Generic1 f, Monad (Rep1 f)) => Monad (Generically1 f) where
return = pure
m >>= f = tog1 $ fromg1 m >>= fromg1 . f
and to use it we first derive Generic1 for our data type and then derive Applicative via our new Generically1 wrapper:
data Foo x = Foo x (Int -> x) (Foo x)
deriving (Functor, Generic1)
deriving (Applicative, Monad) via Generically1 Foo
data Bar x = Bar x (IO x)
deriving (Functor, Generic1)
deriving (Applicative, Monad) via Generically1 Bar
data Baz f x = Baz (f x) (f x)
deriving (Show, Functor, Generic1)
deriving (Applicative, Monad) via Generically1 (Baz f)
As you can see, we did not only derive Applicative for our data types but could also derive Monad.
The reason that this works is that there are instances for Applicative and Monad for the Generic1 representations of these data types. See for example the Product type (:*:). There is however no instance of Applicative for the Sum type (:+:), which is why we can't derive it for non-deterministic types.
You can see the Generic1 representation of a data type by writing :kind! Rep1 Foo in GHCi. Here are simplified versions (excluding meta-data) of the representations for the types above:
type family Simplify x where
Simplify (M1 i c f) = Simplify f
Simplify (f :+: g) = Simplify f :+: Simplify g
Simplify (f :*: g) = Simplify f :*: Simplify g
Simplify x = x
λ> :kind! Simplify (Rep1 Foo)
Simplify (Rep1 Foo) :: * -> *
= Par1 :*: (Rec1 ((->) Int) :*: Rec1 Foo)
λ> :kind! Simplify (Rep1 Bar)
Simplify (Rep1 Bar) :: * -> *
= Par1 :*: Rec1 IO
λ> :kind! forall f. Simplify (Rep1 (Baz f))
forall f. Simplify (Rep1 (Baz f)) :: k -> *
= forall (f :: k -> *). Rec1 f :*: Rec1 f
Edit: The Generically1 wrapper is also available here: https://hackage.haskell.org/package/generic-data-0.7.0.0/docs/Generic-Data.html#t:Generically1

Is it possible to encode a generic "lift" function in Haskell?

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).

Resources