<div dir="ltr">hrm, wouldn't your proposed extension be largely accomplished by using Record pun and Record WildCards?<div><br></div><div>eg </div><div><br></div><div>{-# LANGUAGE <span style="color:rgb(0,0,0);font-family:monospace;font-size:medium">RecordWildCards </span>#-}</div><div>{-# LANGUAGE  RecordPuns #-}</div><div>module Foo where</div><div>data Relation a = Rel{related :: a -> a ->Bool,unrelated :: a -> a -> Bool}</div><div><br></div><div>foo :: Relation A -> A -> A -> Bool</div><div>foo Rel{..} x y = related x y </div><div><br></div><div>------</div><div>or am i over looking something?</div><div>I do realize this may not quite be what youre suggesting, and if so, could you help me understand better? :) </div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Fri, Apr 24, 2015 at 4:26 PM, Ertugrul Söylemez <span dir="ltr"><<a href="mailto:ertesx@gmx.de" target="_blank">ertesx@gmx.de</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">> 3. NonStrictPoSet, which is the class of all partially ordered<br>
> set-like things, but without the requirement that a <= b and b <= a<br>
> implies a Equal b.<br>
<br>
Those are preorders.  An antisymmetric preorder is a non-strict poset.<br>
<br>
Also it's difficult to capture all of those various order types in<br>
Haskell's class system.  A type can have many orders and many underlying<br>
equivalence relations in the case of partial and total orders, and there<br>
are different ways to combine them.  For example equality is a partial<br>
order, modular equivalence is a preorder, etc.  Those denote bags and<br>
groups more than sequences or trees.<br>
<br>
Perhaps it's time to add a type class-like system to Haskell, but for<br>
explicitly passed arguments:<br>
<br>
    record Relation a where<br>
        related :: a -> a -> Bool<br>
<br>
        unrelated :: a -> a -> Bool<br>
        unrelated x y = not (related x y)<br>
<br>
    func1 :: Relation A -> A -> A -> A<br>
    func1 _ x y = ... related x y ...<br>
<br>
    func2 :: Relation A -> Relation A -> A -> A -> A<br>
    func2 r1 r2 x y = ... r1.related x y ... r2.unrelated x y ...<br>
<br>
In a lot of cases this is much more appropriate than a type class, and<br>
it would turn many things that are currently types into regular<br>
functions, thus making them a lot more composable:<br>
<br>
    down :: Ord a -> Ord a<br>
    down o =<br>
        Ord { compare x y = o.compare y x }<br>
        -- The remaining Ord functions are defaulted.<br>
<br>
Perhaps all we need is to generalise default definitions to data types<br>
and add module-like dot syntax for records (mainly to preserve infix<br>
operators).  Formally speaking there is also little that prevents us<br>
>From having associated types in those records that can be used on the<br>
type level.<br>
<br>
For actual record types (i.e. single-constructor types) we could even<br>
have specialisation and get a nice performance boost that way, if we ask<br>
for it:<br>
<br>
    {-# SPECIALISE down someOrder :: Ord SomeType #-}<br>
<br>
This would be extremely useful.<br>
<br>
<br>
> 4. Things like above, but with the requirement of a Zero, with the<br>
> requirement of a One, and the requirement fo both a Zero and a One.<br>
<br>
Zero and one as in minBound and maxBound or rather as in Monoid and a<br>
hypothetical Semiring?  In the latter case I believe they don't really<br>
belong into an additional class, unless you have some ordering-related<br>
laws for the zeroes and ones.  If not, you can always simply use an<br>
Ord+Semiring constraint.<br>
<br>
There may be some motivation to make Bounded a subclass of Ord though.<br>
<br>
<br>
Greets,<br>
Ertugrul<br>
<br>_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
<br></blockquote></div><br></div>