Diamond-like interface constraints issue - typeclass

I've written an implementation of an Applicative and VerifiedApplicative for a pair with a monoid:
import Interfaces.Verified
VerifiedMonoid a => Applicative (Pair a) where
(l, f) <*> (r, x) = (l <+> r, f x)
pure x = (neutral, x)
VerifiedMonoid a => VerifiedApplicative (Pair a) where
applicativeMap (l, x) g = sym $ cong {f=(\y => (y, g x))} (monoidNeutralIsNeutralR l)
applicativeIdentity = ?h1
applicativeComposition = ?h2
applicativeHomomorphism = ?h3
applicativeInterchange = ?h4
Although it compiles, if I weaken a condition on a in Applicative instance as follows:
Monoid a => Applicative (Pair a) where
(l, f) <*> (r, x) = (l <+> r, f x)
pure x = (neutral, x)
I see an error message complaining on applicativeMap:
When checking right hand side of Interfaces.Verified.Contravariant.Pair a implementation of Interfaces.Verified.VerifiedApplicative, method applicativeMap with expected type
map g (l, x) = pure g <*> (l, x)
When checking an application of function Prelude.Basics.cong:
Type mismatch between
(<+>) {{constructor of Interfaces.Verified.VerifiedSemigroup#Semigroup a {{constructor of Interfaces.Verified.VerifiedMonoid#VerifiedSemigroup a}}}}
neutral
l =
l (Type of monoidNeutralIsNeutralR l)
and
(<+>) {{constructor of Prelude.Algebra.Monoid#Semigroup ty {{constructor of Interfaces.Verified.VerifiedMonoid#Monoid a}}}} neutral l = l (Expected type)
Specifically:
Type mismatch between
(<+>) {{constructor of Interfaces.Verified.VerifiedSemigroup#Semigroup a {{constructor of Interfaces.Verified.VerifiedMonoid#VerifiedSemigroup a}}}}
neutral
l
and
(<+>) {{constructor of Prelude.Algebra.Monoid#Semigroup ty {{constructor of Interfaces.Verified.VerifiedMonoid#Monoid a}}}}
neutral
l
Since it's shown Semigroup ty, apparently Semigroup instance is not inferred. I tried to write it explicitly as (Semigroup a, VerifiedMonoid a) => VerifiedApplicative (Pair a), but it doesn't help.
Also it comes in mind a diamond inheritance issue, since Semigroup => Monoid => VerifiedMonoid and in the same time Semigroup => VerifiedSemigroup => VerifiedMonoid.
Any ideas how to workaround this? Limiting Applicative instance only on VerifiedMonoid is a bit awkward.

Related

How exactly can cong be well-typed?

I was looking at the definition of cong:
cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong f refl = refl
And I couldn't understand why it is well-typed. In particular, it seems like the implicit argument of refl must be both f x and f y. To make things more clear, I wrote a non-implicit version of equality, and attempted to replicate the proof:
data Eq : (A : Set) -> A -> A -> Set where
refl : (A : Set) -> (x : A) -> Eq A x x
cong : (A : Set) -> (B : Set) -> (f : A -> B) ->
(x : A) -> (y : A) -> (e : Eq A x y) -> Eq B (f x) (f y)
cong A B f x y e = refl B (f x)
This results in a type error:
x != y of type A when checking that the expression refl B (f x) has type Eq B (f x) (f y)
As one would expect. What could I possibly have instead of (f x)? Am I missing something?
Dependent pattern matching at your service.
If we make a hole in your cong
cong : (A : Set) -> (B : Set) -> (f : A -> B) ->
(x : A) -> (y : A) -> (e : Eq A x y) -> Eq B (f x) (f y)
cong A B f x y e = {!refl B (f x)!}
and look into it, we'll see
Goal: Eq B (f x) (f y)
Have: Eq B (f x) (f x)
so the values are indeed different. But once you pattern match on e:
cong : (A : Set) -> (B : Set) -> (f : A -> B) ->
(x : A) -> (y : A) -> (e : Eq A x y) -> Eq B (f x) (f y)
cong A B f x y (refl .A .x) = {!refl B (f x)!}
the fact that x is the same thing as y is revealed and the context is silently rewritten: each occurrence of y is replaced by x, so looking into the hole we now see
Goal: Eq B (f x) (f x)
Have: Eq B (f x) (f x)
Note that we can write
cong A B f x .x (refl .A .x) = refl B (f x)
i.e. do not bind y at all and just say that it's the same as x via a dot-pattern. We gained this information by pattern matching on e : Eq A x y, because once the match is performed we know that it's e : Eq A x x actually, because that's what the type signature of refl says. Unification of Eq A x y and Eq A x x results in a trivial conclusion: y equals x and the whole context is adjusted accordingly.
That's the same logic as with Haskell GADTs:
data Value a where
ValueInt :: Int -> Value Int
ValueBool :: Bool -> Value Bool
eval :: Value a -> a
eval (ValueInt i) = i
eval (ValueBool b) = b
when you match on ValueInt and get i of type Int, you also reveal that a equals Int and add this knowledge to the context (via an equality constraint) which makes a and Int unifiable later. That is how we're able to return i as a result: because a from the type signature and Int unify perfectly as we know from the context.

Why is defining an instance of Choice failing with unknown value?

UPDATE: I'm inlining the code here instead.
I'm trying to define an instance of Data.Profunctor.Choice where right is defined by calling left, but for some reason the compiler complains that left is unknown.
newtype StateTrans s i o = ST (Tuple s i → Tuple s o)
instance stFunctor ∷ Functor (StateTrans s a) where
map f (ST st) = ST $ second f <<< st
instance stProfunctor ∷ Profunctor (StateTrans s) where
dimap f g (ST st) = ST $ second g <<< st <<< second f
instance stChoice ∷ Choice (StateTrans s) where
left (ST f) = ST lf
where
lf (Tuple s (Left a)) = let (Tuple s' b) = f (Tuple s a)
in Tuple s' (Left b)
lf (Tuple s (Right c)) = Tuple s (Right c)
-- Fails to compile with: Unknown value left
right f = arr mirror <<< left f <<< arr mirror
where
mirror Left x = Right x
mirror Right x = Left x
Probably a silly mistake but I've been looking at my code for so long, I can't figure out what's wrong.
(Of minor importance and unrelated: in the Right case for left, I have to unwrap and repackage the value so that it type-aligns. Adding a type ascription fails to compile too.)
Strangely enough, I have no problem doing the same for Strong, see:
instance stStrong ∷ Strong (StateTrans s) where
first (ST f) = ST ff
where
ff (Tuple s (Tuple a c)) = let (Tuple s' b) = f $ Tuple s a
in Tuple s' (Tuple b c)
second f = arr swap <<< first f <<< arr swap
I'm not 100% sure as the pasted snippet doesn't include imports, but I suspect you have an import for Data.Profunctor.Choice (class Choice) rather than Data.Profunctor.Choice (class Choice, left, right).
Importing a class does not import its members implicitly, even though it is possible to define them in an instance without doing so.
First, to use arr you need to declare the Category instance for StateTrans s:
instance stSemigroupoid :: Semigroupoid (StateTrans s) where
compose (ST f1) (ST f2) = ST $ f1 <<< f2
instance stCategory :: Category (StateTrans s) where
id = ST $ \x -> x
For the second step, I needed to add more type annotations (not sure why they're necessary, but this way the build succeeded):
choiceLeft :: forall input output a s. (StateTrans s) input output -> (StateTrans s) (Either input a) (Either output a)
choiceLeft (ST f) = ST lf
where
lf (Tuple s (Left a)) = let (Tuple s' b) = f (Tuple s a)
in Tuple s' (Left b)
lf (Tuple s (Right c)) = Tuple s (Right c)
choiceRight :: forall input output t s. (StateTrans s) input output -> (StateTrans s) (Either t input) (Either t output)
choiceRight f = amirror <<< choiceLeft f <<< amirror
where
mirror :: forall a b. Either a b -> Either b a
mirror (Left x) = Right x
mirror (Right x) = Left x
amirror :: forall a b. StateTrans s (Either b a) (Either a b)
amirror = arr mirror
instance stChoice ∷ Choice (StateTrans s) where
left = choiceLeft
right = choiceRight
Note: used PureScript version 0.11.7 and purescript-profunctor version 3.2.0.

With leftOuterJoin, .DefaultIfEmpty() is unnecessary

The documentation for leftOuterJoin Query Expressions on MSDN repeatedly implies through the samples that when using leftOuterJoin .. on .. into .. that you must still use .DefaultIfEmpty() to achieve the desired effect.
I don't believe this is necessary because I get the same results in both of these tests which differ only in that the second one does not .DefaultIfEpmty()
type Test = A | B | C
let G = [| A; B; C|]
let H = [| A; C; C|]
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I.DefaultIfEmpty() do
select (g, i)}
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I do
select (g, i)}
// seq [(A, A); (B, null); (C, C); (C, C)]
// seq [(A, A); (B, null); (C, C); (C, C)]
1) Can you confirm this?
If that's right, I realized it only after writing this alternate type augmentation in an attempt to better deal with unmatched results and I was surprised to still see nulls in my output!
type IEnumerable<'TSource> with
member this.NoneIfEmpty = if (Seq.exists (fun _ -> true) this)
then Seq.map (fun e -> Some e) this
else seq [ None ]
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I.NoneIfEmpty do
select (g, i)}
// seq [(A, Some A); (B, Some null); (C, Some C); (C, Some C)]
2) Is there a way to get None instead of null/Some null from the leftOuterJoin?
3) What I really want to do is find out if there are any unmatched g
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I.NoneIfEmpty do
where (i.IsNone)
exists (true) }
I figured this next one out but it isn't very F#:
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I do
where (box i = null)
exists (true)}
Short version: Query Expressions use nulls. It's a rough spot in the language, but a containable one.
I've done this before:
let ToOption (a:'a) =
match obj.ReferenceEquals(a,null) with
| true -> None
| false -> Some(a)
This will let you do:
printfn "%A" <| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I do
select ( g,(ToOption i))}
Which wraps every result in an option (since you don't know if there is going to be an I. It's worth noting that F# uses null to represent None at run-time as an optimization. So to check if this is indeed what you want, make a decision on the option, like:
Seq.iter (fun (g,h) ->
printf "%A," g;
match h with
| Some(h) -> printfn "Some (%A)" h
| None -> printfn "None")
<| query {
for g in G do
leftOuterJoin h in H on (g = h) into I
for i in I do
select ((ToOption g),(ToOption i))}

How do I prove a "seemingly obvious" fact when relevant types are abstracted by a lambda in Idris?

I am writing a basic monadic parser in Idris, to get used to the syntax and differences from Haskell. I have the basics of that working just fine, but I am stuck on trying to create VerifiedSemigroup and VerifiedMonoid instances for the parser.
Without further ado, here's the parser type, Semigroup, and Monoid instances, and the start of a VerifiedSemigroup instance.
data ParserM a = Parser (String -> List (a, String))
parse : ParserM a -> String -> List (a, String)
parse (Parser p) = p
instance Semigroup (ParserM a) where
p <+> q = Parser (\s => parse p s ++ parse q s)
instance Monoid (ParserM a) where
neutral = Parser (const [])
instance VerifiedSemigroup (ParserM a) where
semigroupOpIsAssociative (Parser p) (Parser q) (Parser r) = ?whatGoesHere
I'm basically stuck after intros, with the following prover state:
-Parser.whatGoesHere> intros
---------- Other goals: ----------
{hole3},{hole2},{hole1},{hole0}
---------- Assumptions: ----------
a : Type
p : String -> List (a, String)
q : String -> List (a, String)
r : String -> List (a, String)
---------- Goal: ----------
{hole4} : Parser (\s => p s ++ q s ++ r s) =
Parser (\s => (p s ++ q s) ++ r s)
-Parser.whatGoesHere>
It looks like I should be able to use rewrite together with appendAssociative somehow,
but I don't know how to "get inside" the lambda \s.
Anyway, I'm stuck on the theorem-proving part of the exercise - and I can't seem to find much Idris-centric theorem proving documentation. I guess maybe I need to start looking at Agda tutorials (though Idris is the dependently-typed language I'm convinced I want to learn!).
The simple answer is that you can't. Reasoning about functions is fairly awkward in intensional type theories. For example, Martin-Löf's type theory is unable to prove:
S x + y = S (x + y)
0 + y = y
x +′ S y = S (x + y)
x +′ 0 = x
_+_ ≡ _+′_ -- ???
(as far as I know, this is an actual theorem and not just "proof by lack of imagination"; however, I couldn't find the source where I read it). This also means that there is no proof for the more general:
ext : ∀ {A : Set} {B : A → Set}
{f g : (x : A) → B x} →
(∀ x → f x ≡ g x) → f ≡ g
This is called function extensionality: if you can prove that the results are equal for all arguments (that is, the functions are equal extensionally), then the functions are equal as well.
This would work perfectly for the problem you have:
<+>-assoc : {A : Set} (p q r : ParserM A) →
(p <+> q) <+> r ≡ p <+> (q <+> r)
<+>-assoc (Parser p) (Parser q) (Parser r) =
cong Parser (ext λ s → ++-assoc (p s) (q s) (r s))
where ++-assoc is your proof of associative property of _++_. I'm not sure how would it look in tactics, but it's going to be fairly similar: apply congruence for Parser and the goal should be:
(\s => p s ++ q s ++ r s) = (\s => (p s ++ q s) ++ r s)
You can then apply extensionality to get assumption s : String and a goal:
p s ++ q s ++ r s = (p s ++ q s) ++ r s
However, as I said before, we don't have function extensionality (note that this is not true for type theories in general: extensional type theories, homotopy type theory and others are able to prove this statement). The easy option is to assume it as an axiom. As with any other axiom, you risk:
Losing consistency (i.e. being able to prove falsehood; though I think function extensionality is OK)
Breaking reduction (what does a function that does case analysis only for refl do when given this axiom?)
I'm not sure how Idris handles axioms, so I won't go into details. Just beware that axioms can mess up some stuff if you are not careful.
The hard option is to work with setoids. A setoid is basically a type equipped with custom equality. The idea is that instead of having a Monoid (or VerifiedSemigroup in your case) that works on the built-in equality (= in Idris, ≡ in Agda), you have a special monoid (or semigroup) with different underlying equality. This is usually done by packing the monoid (semigroup) operations together with the equality and bunch of proofs, namely (in pseudocode):
= : A → A → Set -- equality
_*_ : A → A → A -- associative binary operation
1 : A -- neutral element
=-refl : x = x
=-trans : x = y → y = z → x = z
=-sym : x = y → y = x
*-cong : x = y → u = v → x * u = y * v -- the operation respects
-- our equality
*-assoc : x * (y * z) = (x * y) * z
1-left : 1 * x = x
1-right : x * 1 = x
The choice of equality for parsers is clear: two parsers are equal if their outputs agree for all possible inputs.
-- Parser equality
_≡p_ : {A : Set} (p q : ParserM A) → Set
Parser p ≡p Parser q = ∀ x → p x ≡ q x
This solution comes with different tradeoffs, namely that the new equality cannot fully substitute the built-in one (this tends to show up when you need to rewrite some terms). But it's great if you just want to show that your code does what it's supposed to do (up to some custom equality).

How can I make a Maybe-Transformer MaybeT into an instance of MonadWriter?

I am trying to build a MaybeT-Transformer Monad, based on the example in the Real World Haskell, Chapter Monad Transformers:
data MaybeT m a = MaybeT { runMT :: m (Maybe a) }
instance (Monad m) => Monad (MaybeT m) where
m >>= f = MaybeT $ do a <- runMT m
case a of
Just x -> runMT (f x)
Nothing -> return Nothing
return a = MaybeT $ return (Just a)
instance MonadTrans MaybeT where
lift m = MaybeT $ do
a <- m
return (Just a)
This works fine, but now I want to make MaybeT an instance of MonadWriter:
instance (MonadWriter w m) => MonadWriter w (MaybeT m) where
tell = lift . tell
listen m = MaybeT $ do unwrapped <- listen (runMT m)
return (Just unwrapped)
The tell is ok, but I can't get the listen function right. The best I could come up with after 1 1/2 days of constructor origami is the one you see above: unwrapped is supposed to be a tuple of (Maybe a, w), and that I want to wrap up in a Maybe-Type and put the whole thing in an empty MonadWriter.
But the compiler complains with:
Occurs check: cannot construct the infinite type: a = Maybe a
When generalising the type(s) for `listen'
In the instance declaration for `MonadWriter w (MaybeT m)'
What am I missing?
listen has type signature
m a -> m (a, w)
i.e.
MaybeT m a -> MaybeT m (a, w)
But MaybeT $ listen (runMT m) >>= return . Just has type signature
MaybeT m a -> MaybeT m (Maybe a, w)
so the infinite type error is raised. You need to convert that unwrapped :: (Maybe a, w) into a Maybe (a, w) to proceed:
listen m = MaybeT $ do (val, wr) <- listen (runMT m)
case val of
Nothing -> return Nothing
Just x -> return (Just (x, wr))
(BTW, there is an implementation of MaybeT in http://www.haskell.org/haskellwiki/New_monads/MaybeT.)

Resources