[Haskell-cafe] GHC shows wrong line number in error?

2012-12-20 Thread Niklas Hambüchen
Hello,

I have some code like this (the contents don't really matter):

42  data TestChain next = ChainEntry (forall b . TestG b) next
43  | ChainDescribe String (Free TestChain...
44  deriving (Functor)
45
46  -- deriving instance Show a = Show (TestChain a)
47
48  it :: (SomeT typ, Partition t typ) = String - t - ...
49  it desc test = liftF (ChainEntry (mkTestG test) ())

And get the error:

Clean.hs:49:43:
Could not deduce (t ~ b)
from the context (SomeT typ, Partition t typ)
  bound by the type signature for
 it :: (SomeT typ, Partition t typ) =
   String - t - Free TestChain ()
  at Clean.hs:49:1-51
  `t' is a rigid type variable bound by
  the type signature for
it :: (SomeT typ, Partition t typ) =
  String - t - Free TestChain ()
  at Clean.hs:49:1
  `b' is a rigid type variable bound by
  a type expected by the context: TestG b at Clean.hs:49:23
[...]

In that last error line, should that not be Clean.hs:42:... (as it
references the 'b', which I only really have there), or is that
intended, and if yes, why?

I'm using GHC 7.4.2.

Thanks
Niklas

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC shows wrong line number in error?

2012-12-20 Thread Roman Cheplyaka
* Niklas Hambüchen m...@nh2.me [2012-12-20 08:47:17+]
 Hello,
 
 I have some code like this (the contents don't really matter):
 
 42  data TestChain next = ChainEntry (forall b . TestG b) next
 43  | ChainDescribe String (Free TestChain...
 44  deriving (Functor)
 45
 46  -- deriving instance Show a = Show (TestChain a)
 47
 48  it :: (SomeT typ, Partition t typ) = String - t - ...
 49  it desc test = liftF (ChainEntry (mkTestG test) ())
 
 And get the error:
 
 Clean.hs:49:43:
 Could not deduce (t ~ b)
 from the context (SomeT typ, Partition t typ)
   bound by the type signature for
  it :: (SomeT typ, Partition t typ) =
String - t - Free TestChain ()
   at Clean.hs:49:1-51
   `t' is a rigid type variable bound by
   the type signature for
 it :: (SomeT typ, Partition t typ) =
   String - t - Free TestChain ()
   at Clean.hs:49:1
   `b' is a rigid type variable bound by
   a type expected by the context: TestG b at Clean.hs:49:23
 [...]
 
 In that last error line, should that not be Clean.hs:42:... (as it
 references the 'b', which I only really have there), or is that
 intended, and if yes, why?
 
 I'm using GHC 7.4.2.

Because there's no error on line 42. It's a fine type declaration, and
saying it contains an error would be utterly confusing.

But *given* that type declaration, your code on line 49 is incorrect,
and that's what GHC is saying.

To consider a simpler example, writing foo :: Int is incorrect because
foo is not an Int. But the problem is in the assertion that foo has
type Int, and not in the type declaration itself, although the error message 
would presumably reference Int.

Roman

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Categories (cont.)

2012-12-20 Thread Christopher Howard
I've perhaps been trying everyones patiences with my noobish CT
questions, but if you'll bear with me a little longer: I happened to
notice that there is in fact a Category class in Haskell base, in
Control.Category:

quote:

class Category cat where

A class for categories. id and (.) must form a monoid.

Methods

id :: cat a a

the identity morphism

(.) :: cat b c - cat a b - cat a c

morphism composition


However, the documentation lists only two instances of Category,
functions (-) and Kleisli Monad. For instruction purposes, could
someone show me an example or two of how to make instances of this
class, perhaps for a few of the common types? My initial thoughts were
something like so:

code:

instance Category Integer where

  id = 1

  (.) = (*)

-- and

instance Category [a] where

  id = []
  (.) = (++)
---

But these lead to kind mis-matches.

-- 
frigidcode.com



signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] category design approach for inconvenient concepts

2012-12-20 Thread wren ng thornton

On 12/17/12 9:45 PM, Christopher Howard wrote:

So you could have...

(coupler . thing) . gadget

Because the coupler and the thing would combine to create a component
with one spare connector. This would then combine with the gadget to
make the final component. However, if you did...

coupler . (thing . gadget)

Then thing and gadget combine to make a component with no spare
connectors. And so the new component and the coupler then fail to
combine. Associativity law broken.


I don't know about this particular case, but often when it should be 
associative but isn't problems come up, it helps to rephrase things. 
For example, consider plain old Haskell, but where we make application 
explicit. On the one hand, we can have:


f $ (g $ x)

and that's fine. But it's not equivalent to:

(f $ g) $ x

But the problem here isn't that we don't have associativity; the problem 
is that function application isn't the associative operator. The 
associative operator is function composition. Thus, we can rephrase the 
above as:


f . (g . const x)

Which is indeed equivalent to:

(f . g) . const x

Note that in order to dispense with ($) entirely, we had to replace x 
by const x in order to make it a function just like everything else. 
This is akin to the trick we use in category theory to get away from 
talking about values or elements. If your category has a terminal 
object, which I'll call (), then we can represent the elements of A by 
morphisms ()-A. By terminality there's no interesting structure in 
(), thus, the only information in ()-A is however we're selecting our 
element of A.


This is, of course, the same exact thing that happens in vector spaces 
and the like. If I write (*.) for scaling a vector, then we have:


x *. (y *. a) == (x * y) *. a

which should look suspiciously similar to:

f $ (g $ x) == (f . g) $ x


But from your description, it sounds like the above may not be the 
source of your problem. The second sort of non-associativity problem 
that's common is when dealing with a function of multiple arguments (or 
similar). That is, there are two separate kinds of whitespace for 
application in Haskell. This is easy to see if we switch to the 
Applicative paradigm:


   f $ x * y

Now, for Applicatives this happens because the f above is pure. But we 
also run into it with plain functions--- namely, we can have our 
functions curried or not. We can freely switch between these different 
representations, but we can't get away from the fact that they both 
exist. Thus, there's a sort of inherent difference between the 
juxtaposition of a function and it's (first) argument, vs the 
juxtaposition of multiple arguments. Regardless of whether we view the 
latter as tupling or as subsequent-application, both of those 
perspectives are distinct from the initial-application.


The solution here, I think, is just to recognize what's going on. If you 
need two operators, then you need two operators, and that's fine. With 
the examples above it comes from dealing with a cartesian closed 
category, but there are certainly other structures your operators may be 
examples of.


--
Live well,
~wren

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Petr P
  Hi Christopher,

a data type can be an instance of Category only if it has kind * - * - *.
It must have 2 type parameters so that you could have types like 'cat a a'.

Some simple examples:

import Prelude hiding (id, (.))
import Control.Category
import Data.Monoid

-- See https://en.wikipedia.org/wiki/Opposite_category
newtype Op c a b = Op (c b a)
instance Category c = Category (Op c) where
id = Op id
(Op x) . (Op y) = Op (y . x)

-- A category whose morphisms are bijections between types.
data Iso a b = Iso (a - b) (b - a)
instance Category Iso where
id = Iso id id
(Iso f1 g1) . (Iso f2 g2) = Iso (f1 . f2) (g2 . g1)

-- A product of two categories forms a new category:
data ProductCat c d a b = ProductCat (c a b) (d a b)
instance (Category c, Category d) = Category (ProductCat c d) where
id = ProductCat id id
(ProductCat f g) . (ProductCat f' g') = ProductCat (f . f') (g . g')

-- A category constructed from a monoid. It
-- ignores the types. Any morphism in this category
-- is simply an element of the given monoid.
newtype MonoidCat m a b = MonoidCat m
instance (Monoid m) = Category (MonoidCat m) where
id = MonoidCat mempty
MonoidCat x . MonoidCat y = MonoidCat (x `mappend` y)

Many interesting categories can be constructed from various monads using
Kleisli. For example, Kleisli Maybe is the category of partial functions.

Best regards,
Petr


2012/12/20 Christopher Howard christopher.how...@frigidcode.com

 I've perhaps been trying everyones patiences with my noobish CT
 questions, but if you'll bear with me a little longer: I happened to
 notice that there is in fact a Category class in Haskell base, in
 Control.Category:

 quote:
 
 class Category cat where

 A class for categories. id and (.) must form a monoid.

 Methods

 id :: cat a a

 the identity morphism

 (.) :: cat b c - cat a b - cat a c

 morphism composition
 

 However, the documentation lists only two instances of Category,
 functions (-) and Kleisli Monad. For instruction purposes, could
 someone show me an example or two of how to make instances of this
 class, perhaps for a few of the common types? My initial thoughts were
 something like so:

 code:
 
 instance Category Integer where

   id = 1

   (.) = (*)

 -- and

 instance Category [a] where

   id = []
   (.) = (++)
 ---

 But these lead to kind mis-matches.

 --
 frigidcode.com


 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] category design approach for inconvenient concepts

2012-12-20 Thread wren ng thornton

On 12/18/12 5:03 PM, Christopher Howard wrote:

Since I received the two responses to my question, I've been trying to
think deeply about this subject, and go back and understand the core
ideas. I think the problem is that I really don't have a clear
understanding of the basics of category theory, and even less clear idea
of the connection to Haskell programming. I have been reading every link
I can find, but I'm still finding the ideas of objects and especially
morphisms to be quite vague.


As others have mentioned, that vagueness is, in fact, intentional. 
There are two ways I can think of to help clear up the abstraction. The 
first is just to give a bunch of examples:


the category of sets (objects) and set-theoretic functions (morphisms)
the category of Haskell types and Haskell functions[1]
... (small) categories, and functors
... rings, and ring homomorphisms
... groups, and group homomorphisms
... vectors, and linear transformations
... natural numbers, and matrices
... elements of a poset, and the facts that one element precedes another
... nodes of a directed graph, and paths on that graph


The second approach is to compare it to something you're already 
familiar with. I'm sure you've encountered monoids before: they're just 
an associative operation on some carrier set, plus an element of that 
set which is the identity for the operation. Perhaps the most auspicious 
one to think about is multiplication, or concatenation of lists.


A category is nothing more than a generalization from monoids to 
monoid-oids. That is, with monoids we give our operator the following 
type:


(*) :: A - A - A

but sometimes things aren't so nice. Just think about matrix 
multiplication, or function composition. These are partial operations 
because they only work on some subset of A. The two As must air up in a 
nice way. Thus, what we really have is not one carrier, but a family of 
carriers which are indexed by their input end (domain) and their 
output end (codomain). Thus, we have the type:


(*) :: A i j - A j k - A i k

or

(*) :: A j k - A i j - A i k

where i, j, and k, are our indices. Which one of the above two types you 
get doesn't matter, it's just the difference between () and () in 
Haskell. Of course, now that we've indexed everything, we can't have 
just one identity element for the operation; instead, we need a whole 
family of identity elements:


1 :: A i i

In a significant sense, the objects are really only there to serve as 
indices for the domain and codomain of a morphism. They need not have 
any other significance. A good example of this is when we compare two of 
the example categories above: linear transformations, vs matrices. For 
the category of vector spaces and linear transformations, the objects 
actually mean something: they're vector spaces. However, in the category 
of natural numbers and matrices, the natural numbers only serve to tell 
us the dimensions of the matrices so that we know whether we can 
multiply them together or not. Thus, these are different categories, 
even though they're the same in just about every regard.



[1] Note that this may not actually work out to be a category, but the 
basic idea is sound.




But here I am
confused: If functions are a category, this would seem to imply (by
the phrasing) that functions are the objects of the category. However,
since we compose functions, and only morphisms are composed, it would
follow that functions are actually morphisms. So, in the function
category, are functions objects or morphisms? If they are morphisms,
then what are the objects of the category?


Objects in Haskell are types, and functions aren't types. But cherish 
that confusion for a bit, because it hints at a deeper thing going on 
here. In the simplest scenario, functions are the morphisms between 
objects (i.e., types). But what happens when we consider higher-order 
functions?


In Haskell we write things like:

(A - B) - C
D - (E - F)

Whereas, in category theory we would distinguish the first-order arrows 
from the higher-order arrows:


B^A - C
D - F^E

That is, we have an object B^A (read that as an exponent), and we have a 
class of morphisms A-B (sometimes this class is instead written 
Hom(A,B)). These are different things, though we willfully conflate them 
in functional programming. The B^A can be thought of as the class of all 
functions from A to B when we consider these functions as data; whereas 
the A-B can be thought of as the class of all functions from A to B 
when we consider these functions as procedures to be executed. Part of 
the reason we conflate these in functional programming is because we 
know that the one reflects the other. Whereas the reason category theory 
distinguishes them is because this sort of reflection isn't possible in 
all categories. Some categories have exponential objects, others don't.[2]


Thus, when you ask whether a function belongs to an object or to a 

Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread wren ng thornton

On 12/20/12 6:42 AM, Christopher Howard wrote:

code:

instance Category Integer where

   id = 1

   (.) = (*)

-- and

instance Category [a] where

   id = []
   (.) = (++)
---

But these lead to kind mis-matches.


As mentioned in my other email (just posted) the kind mismatch is 
because categories are actually monoid-oids[1] not monoids. That is:


class Monoid (a :: *) where
mempty  :: a
mappend :: a - a - a

class Category (a :: * - * - *) where
id  :: a i j
(.) :: a j k - a i j - a i k

Theoretically speaking, every monoid can be considered as a category 
with only one object. Since there's only one object/index, the types for 
id and (.) basically degenerate into the types for mempty and mappend. 
Notably, from this perspective, each of the elements of the carrier set 
of the monoid becomes a morphism in the category--- which some people 
find odd at first.


In order to fake this theory in Haskell we can do:

newtype MonoidCategory a i j = MC a

instance Monoid a = Category (MonoidCategory a) where
id  = MC mempty
MC f . MC g = MC (f `mappend` g)

This is a fake because technically (MonoidCategory A X Y) is a different 
type than (MonoidCategory A P Q), but since the indices are phantom 
types, we (the programmers) know they're isomorphic. From the category 
theory side of things, we have K*K many copies of the monoid where K is 
the cardinality of the kind *. We can capture this isomorphism if we like:


castMC :: MonoidCategory a i j - MonoidCategory a k l
castMC (MC a) = MC a

but Haskell won't automatically insert this coercion for us; we gotta do 
it manually. In more recent versions of GHC we can use data kinds in 
order to declare a kind like:


MonoidCategory :: * - () - () - *

which would then ensure that we can only talk about (MonoidCategory a () 
()). Unfortunately, this would mean we can't use the Control.Category 
type class, since this kind is more restrictive than (* - * - * - *). 
But perhaps in the future that can be fixed by using kind polymorphism...



[1] The -oid part just means the indexing. We don't use the term 
monoidoid because it's horrific, but we do use a bunch of similar 
terms like semigroupoid, groupoid, etc.


--
Live well,
~wren

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hoogle index completeness

2012-12-20 Thread Carlos López Camey
2012/12/19 Joachim Breitner m...@joachim-breitner.de:
 if Michael Snoyman’s  stackage will fly, I’d that would be a good
 candidate for a default set.

+10

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHC shows wrong line number in error?

2012-12-20 Thread Brandon Allbery
On Thu, Dec 20, 2012 at 3:47 AM, Niklas Hambüchen m...@nh2.me wrote:

   `b' is a rigid type variable bound by
   a type expected by the context: TestG b at Clean.hs:49:23


It might be worth rephrasing this error message somehow, although I suspect
it's written to fit into existing error reporting machinery that's not easy
to adapt to fit the situation:  the location is not referring to TestG b,
but to a type on line 49, which is expected/generated by the context
TestG b established previously.  You have to read pretty closely to figure
that out, though.

-- 
brandon s allbery kf8nh   sine nomine associates
allber...@gmail.com  ballb...@sinenomine.net
unix, openafs, kerberos, infrastructure, xmonadhttp://sinenomine.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] category design approach for inconvenient concepts

2012-12-20 Thread Oleksandr Manzyuk
 the category of Haskell types and Haskell functions[1]

 [1] Note that this may not actually work out to be a category, but the basic
 idea is sound.

I would be curious to see this example carefully worked out.  I often
hear that Haskell types and Haskell functions constitute a category,
but I have seen no rigorous definition.

I have no problems with the statement Objects of the category Hask
are Haskell types.  Types are well-defined syntactic entities.  But
what is a morphism in the category Hask from a to b?  Commonly, people
say functions from a to b or functions a - b, but what does that
mean?  What is a function as a mathematical object?  It is a plausible
idea to say that a function from a to b is a closed term of type a -
b (and terms are again well-defined syntactic entities).  How do we
define composition?  Presumably, by

f . g = \x - f (g x)

This however already presupposes that we are dealing not with raw
terms, but with their alpha-equivalence classes (otherwise the above
is not well-defined as it depends on the choice of the variable x).
Even if we mod out alpha-equivalence, so defined composition fails to
be associative on the nose, up to equality of (alpha-equivalence
classes of) terms.  Apparently, we want to consider equivalence
classes of terms modulo some finer equivalence relation.  What is this
equivalence relation?  Some kind of definitional equality?

Apparently, this (rather non-trivial) exercise has already been
carried out for the simply typed lambda-calculus.  I'd be curious to
see how that generalizes to Haskell (or some equivalent formal
system).

Sasha
-- 
Oleksandr Manzyuk
http://oleksandrmanzyuk.wordpress.com

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] category design approach for inconvenient concepts

2012-12-20 Thread Jay Sulzberger



On Thu, 20 Dec 2012, Oleksandr Manzyuk manz...@gmail.com wrote:


the category of Haskell types and Haskell functions[1]

[1] Note that this may not actually work out to be a category, but the basic
idea is sound.


I would be curious to see this example carefully worked out.  I often
hear that Haskell types and Haskell functions constitute a category,
but I have seen no rigorous definition.

I have no problems with the statement Objects of the category Hask
are Haskell types.  Types are well-defined syntactic entities.  But
what is a morphism in the category Hask from a to b?  Commonly, people
say functions from a to b or functions a - b, but what does that
mean?  What is a function as a mathematical object?  It is a plausible
idea to say that a function from a to b is a closed term of type a -
b (and terms are again well-defined syntactic entities).  How do we
define composition?  Presumably, by

f . g = \x - f (g x)

This however already presupposes that we are dealing not with raw
terms, but with their alpha-equivalence classes (otherwise the above
is not well-defined as it depends on the choice of the variable x).
Even if we mod out alpha-equivalence, so defined composition fails to
be associative on the nose, up to equality of (alpha-equivalence
classes of) terms.  Apparently, we want to consider equivalence
classes of terms modulo some finer equivalence relation.  What is this
equivalence relation?  Some kind of definitional equality?

Apparently, this (rather non-trivial) exercise has already been
carried out for the simply typed lambda-calculus.  I'd be curious to
see how that generalizes to Haskell (or some equivalent formal
system).

Sasha


Yes.  It would be well worth carefully carrying out your program
for some approximation of a large part of Haskell as she lives in
GHC.  As mentioned earlier, we should not ignore the distinctions
between

  a. the text of a Haskell program
  b. the binary of the now compiled program
  c. the running of the program
  d. the input output behavior of the program

Attempting to force the hoped for clarification to operate only
on one part of the whole at least four part structure is likely
to not give us what we, ah, I, really want to see.

There is some work directly dealing with part of the program:

  http://www.haskell.org/haskellwiki/Hask

oo--JS.



--
Oleksandr Manzyuk
http://oleksandrmanzyuk.wordpress.com


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Jay Sulzberger



On Thu, 20 Dec 2012, Christopher Howard christopher.how...@frigidcode.com 
wrote:


I've perhaps been trying everyones patiences with my noobish CT
questions, but if you'll bear with me a little longer: I happened to
notice that there is in fact a Category class in Haskell base, in
Control.Category:

quote:

class Category cat where

A class for categories. id and (.) must form a monoid.

Methods

id :: cat a a

the identity morphism



Here we run into at least one general phenomenon, which wren ng thornton
discusses in this thread.  One phenomenon is:

1. Different formalizations of the same concept, here category,
strike the student when they are first seen, as completely
different things.  In particular, different formalisms often have
different types, where by types here, we mean types in the
implicit type system the student assumes.  The Haskell
declaration

  id :: cat a a

declares that id is an element of type (cat a a), that is, that
given any (suitable) type a, there is an element which we call
id of the type (cat a a).  Here (cat a a) might be read as the
type of all morphisms between an element of type *anything* and
another element of type *anything*, where the two types are
the same.  Now in most category theory textbooks we have an axiom

  For each object obj in the category, we have a morphism
  identity(obj): obj - obj
  That is, we have a map defined on Obj the set of objects
  of our category, which takes values in the Mor, the (disjoint)
  union of Mor(a,b) over all objects of our category.

One natural-to-the-beginner idea is that to do a
translation^Winterpretation of this into Haskell, we would need a
a Haskell procedure defined on (approximately) all types a which,
once we fix our category C, will hand us back a procedure of type
(C a a).  Note that this Identity procedure takes as input a type
and hands back a lower level thing, namely a value of type
(C a a).  So the type of Identity in our approximation of Haskell
would be:

  * - (C * *)

where we have the constraint

  All the textual *s appearing in above line,
  refer to the same type

Now, I am a beginner in Haskell, and I am not sure whether we can
make such a declaration in Haskell.  In my naive type system
(id :: cat a a) gives id a different type from Identity.
Identity takes one input, patently, but id seems to take no
inputs.  Admittedly we may pass easily by means of a functor
(imprecision here, what are the two categories for this functor?)
from id to Identity, and by another functor, back.  I do think
that Haskell's handling of universally polymorphic types does
indeed provide for automatic, behind the source code, application
of these two functors.

To be painfully explicit: (id :: cat a a) says, in my naive type
theory, that id is a name for some particular element of
(cat a a).  Identity(a) is the result of applying Identity to the
type a.  A name is at a different level from the thing named, in
my naive type theory.

2. The above is a tiny example of the profusion of swift
apparently impossible conflations and swift implicit, and often
also explicit, distinctions which are sometimes offered in
response to the beginner's puzzlement.


(.) :: cat b c - cat a b - cat a c

morphism composition


However, the documentation lists only two instances of Category,
functions (-) and Kleisli Monad. For instruction purposes, could
someone show me an example or two of how to make instances of this
class, perhaps for a few of the common types? My initial thoughts were
something like so:

code:

instance Category Integer where

 id = 1

 (.) = (*)

-- and

instance Category [a] where

 id = []
 (.) = (++)
---

But these lead to kind mis-matches.

--
frigidcode.com


Ah, OK, let us actually apply some functors.  I shall make some
mistakes in Haskell, I am sure, but the functors are not due to
me, are well known, and I believe, debugged:

Let us rewrite


instance Category Integer where

 id = 1

 (.) = (*)


as


instance Nearcat0 Integer where

 id = 1

 (.) = (*)


This is surely a category, ah, well just about, after we apply
some functor^Wtransformation.  What Nearcat0 is a Haskell thing,
ah, I just now see wren's explication, with Haskell code, in which,
I think Nearcat0 Integer is a thing of type Monoid in Haskell.  I
do not know what a phantom type is, but without the constraint
of having to produce a Haskell interpretation, let us just repeat
the standard category theory textbook explication:

A monoid may be seen as a category as follows:

Let M be a monoid with constant 1, and multiplication *.

Then we may define a category C with one object, which object we
will call, say, theobj.  To each element m of the monoid, we
define a morphism cat(m) in Mor(C) such that

  head(cat(m)) = theobj
  tail(cat(m)) = theobj

and for all m, n in the monoid

  cat(m) * cat(n) = cat(m * n)

where we have written * to mean the composition of morphisms
in C.  Note that once we have specified that C has 

[Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Martin Hilbig

hi,

how to use Language.Haskell.Interpreter.setImports?

i use it like:

  setImports [My.Module]

so that my interpreted modules don't need to:

  import My.Module

But i still get:

  Not in scope: data constructor `MyType'

What am i doing wrong?

Thanks in advance.

have fun
martin

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Michael Sloan
Hello!

Try doing this first:

  loadModules [My.Module]

You may also need to set the searchPath - it defaults to the current
director.  Another good function to know about is setTopLevelModules,
which is just like using :load in ghci - it imports everything in the
module, including its imports.  So, I often do:

  loadModules [MyPrelude]
  setTopLevelModules [MyPrelude]

And stick all of the things that I want to be in scope into MyPrelude.hs.

-Michael


On Thu, Dec 20, 2012 at 3:35 PM, Martin Hilbig li...@mhilbig.de wrote:

 hi,

 how to use Language.Haskell.Interpreter.**setImports?

 i use it like:

   setImports [My.Module]

 so that my interpreted modules don't need to:

   import My.Module

 But i still get:

   Not in scope: data constructor `MyType'

 What am i doing wrong?

 Thanks in advance.

 have fun
 martin

 __**_
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Martin Hilbig

ok, i figured it out so far (just after hitting send ;)

'setImports' makes 'My.Modules' stuff available to the interpreted code 
itself (a call to some of my wrapper functions) but not to my module 
My.Interpreted.Module where which i use via


  setTopLevelModule [My.Interpreted.Module]

So i guess there is no way to add the import to the 
'My.Interpreted.Module' for convenience.


Sorry for the noise.

have fun
martin

On 21.12.2012 00:35, Martin Hilbig wrote:

hi,

how to use Language.Haskell.Interpreter.setImports?

i use it like:

   setImports [My.Module]

so that my interpreted modules don't need to:

   import My.Module

But i still get:

   Not in scope: data constructor `MyType'

What am i doing wrong?

Thanks in advance.

have fun
martin

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Christopher Howard
On 12/20/2012 03:59 AM, wren ng thornton wrote:
 On 12/20/12 6:42 AM, Christopher Howard wrote:
 
 As mentioned in my other email (just posted) the kind mismatch is
 because categories are actually monoid-oids[1] not monoids. That is:
 
 class Monoid (a :: *) where
 mempty  :: a
 mappend :: a - a - a
 
 class Category (a :: * - * - *) where
 id  :: a i j
 (.) :: a j k - a i j - a i k
 
 Theoretically speaking, every monoid can be considered as a category
 with only one object. Since there's only one object/index, the types for
 id and (.) basically degenerate into the types for mempty and mappend.
 Notably, from this perspective, each of the elements of the carrier set
 of the monoid becomes a morphism in the category--- which some people
 find odd at first.
 
 In order to fake this theory in Haskell we can do:
 
 newtype MonoidCategory a i j = MC a
 
 instance Monoid a = Category (MonoidCategory a) where
 id  = MC mempty
 MC f . MC g = MC (f `mappend` g)
 
 This is a fake because technically (MonoidCategory A X Y) is a different
 type than (MonoidCategory A P Q), but since the indices are phantom
 types, we (the programmers) know they're isomorphic. From the category
 theory side of things, we have K*K many copies of the monoid where K is
 the cardinality of the kind *. We can capture this isomorphism if we
 like:
 
 castMC :: MonoidCategory a i j - MonoidCategory a k l
 castMC (MC a) = MC a
 
 but Haskell won't automatically insert this coercion for us; we gotta do
 it manually. In more recent versions of GHC we can use data kinds in
 order to declare a kind like:
 
 MonoidCategory :: * - () - () - *
 
 which would then ensure that we can only talk about (MonoidCategory a ()
 ()). Unfortunately, this would mean we can't use the Control.Category
 type class, since this kind is more restrictive than (* - * - * - *).
 But perhaps in the future that can be fixed by using kind polymorphism...
 
 
 [1] The -oid part just means the indexing. We don't use the term
 monoidoid because it's horrific, but we do use a bunch of similar
 terms like semigroupoid, groupoid, etc.
 

Finally... I actually made some measurable progress, using these
phantom types you mentioned:

code:

import Control.Category

newtype Product i j = Product Integer

  deriving (Show)

instance Category Product where

  id = Product 1

  Product a . Product b = Product (a * b)


I can do composition, illustrate identity, and illustrate associativity:

code:

h Product 5  Product 2
Product 10

h Control.Category.id (Product 3)
Product 3

h Control.Category.id  Product 3
Product 3
h Product 3  Control.Category.id
Product 3

h (Product 2  Product 3)  Product 5
Product 30
h Product 2  (Product 3  Product 5)
Product 30


-- 
frigidcode.com



signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Martin Hilbig

oh that's neat!

but what to do if MyPrelude is provided by some package?

i get this error:

  module `MyPrelude' is a package module

and neither

  set [languageExtensions := [PackageImports]]

nor

  {-# LANGUAGE PackageImports #-}

helps.

have fun
martin

On 21.12.2012 00:55, Michael Sloan wrote:

Hello!

Try doing this first:

   loadModules [My.Module]

You may also need to set the searchPath - it defaults to the current
director.  Another good function to know about is setTopLevelModules,
which is just like using :load in ghci - it imports everything in the
module, including its imports.  So, I often do:

   loadModules [MyPrelude]
   setTopLevelModules [MyPrelude]

And stick all of the things that I want to be in scope into MyPrelude.hs.

-Michael


On Thu, Dec 20, 2012 at 3:35 PM, Martin Hilbig li...@mhilbig.de
mailto:li...@mhilbig.de wrote:

hi,

how to use Language.Haskell.Interpreter.__setImports?

i use it like:

   setImports [My.Module]

so that my interpreted modules don't need to:

   import My.Module

But i still get:

   Not in scope: data constructor `MyType'

What am i doing wrong?

Thanks in advance.

have fun
martin

_
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org mailto:Haskell-Cafe@haskell.org
http://www.haskell.org/__mailman/listinfo/haskell-cafe
http://www.haskell.org/mailman/listinfo/haskell-cafe




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Michael Sloan
Yeah, I've run into that too..

It does seem like there ought to be a better way, but in order to get
around that, I just define the imports (or generate) MyPrelude.hs in the
current directory.  That file can just consist of import
OtherPackage.MyPrelude.

-Michael


On Thu, Dec 20, 2012 at 4:12 PM, Martin Hilbig li...@mhilbig.de wrote:

 oh that's neat!

 but what to do if MyPrelude is provided by some package?

 i get this error:

   module `MyPrelude' is a package module

 and neither

   set [languageExtensions := [PackageImports]]

 nor

   {-# LANGUAGE PackageImports #-}

 helps.

 have fun
 martin


 On 21.12.2012 00:55, Michael Sloan wrote:

 Hello!

 Try doing this first:

loadModules [My.Module]

 You may also need to set the searchPath - it defaults to the current
 director.  Another good function to know about is setTopLevelModules,
 which is just like using :load in ghci - it imports everything in the
 module, including its imports.  So, I often do:

loadModules [MyPrelude]
setTopLevelModules [MyPrelude]

 And stick all of the things that I want to be in scope into
 MyPrelude.hs.

 -Michael


 On Thu, Dec 20, 2012 at 3:35 PM, Martin Hilbig li...@mhilbig.de
 mailto:li...@mhilbig.de wrote:

 hi,

 how to use Language.Haskell.Interpreter._**_setImports?


 i use it like:

setImports [My.Module]

 so that my interpreted modules don't need to:

import My.Module

 But i still get:

Not in scope: data constructor `MyType'

 What am i doing wrong?

 Thanks in advance.

 have fun
 martin

 __**___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org 
 mailto:Haskell-Cafe@haskell.**orgHaskell-Cafe@haskell.org
 
 
 http://www.haskell.org/__**mailman/listinfo/haskell-cafehttp://www.haskell.org/__mailman/listinfo/haskell-cafe
 
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe
 



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] arr considered harmful

2012-12-20 Thread Conal Elliott

 If you require the circuit to be parametric in the value types, you can
 limit the types of function you can pass to arr to simple plumbing.
 See the netlist example at the end of my Fun of Programming slides (
 http://www.soi.city.ac.uk/~ross/papers/fop.html).


I'm running into this same issue: I have something (another circuits
formulation) that's almost an arrow but doesn't support arr. I'd like to
use arrow notation, but then I run afoul of my missing arr. I'd like to
understand Ross's suggestion and how to apply it. (I've read the FoP
slides.)

Ross: do you mean to say that you were able to implement arr and thus run
your circuit examples via the standard arrow desugarer?

Ryan: did you get a working solution to the problem you described for your
Circuit arrow?

Thanks.  -- Conal



On Mon, Oct 31, 2011 at 6:52 PM, Paterson, Ross r.pater...@city.ac.ukwrote:

 Ryan Ingram writes:
  Most of the conversion from arrow syntax into arrows uses 'arr' to move
 components around. However, arr is totally opaque to the arrow itself, and
 prevents describing some very useful objects as arrows.

  For example, I would love to be able to use the arrow syntax to define
 objects of this type:

  data Circuit a b where
  Const :: Bool - Circuit () Bool
  Wire :: Circuit a a
  Delay :: Circuit a a
  And :: Circuit (Bool,Bool) Bool
  Or :: Circuit (Bool,Bool) Bool
  Not :: Circuit Bool Bool
  Then :: Circuit a b - Circuit b c - Circuit a c
  Pair :: Circuit a c - Circuit b d - Circuit (a,b) (c,d)
  First :: Circuit a b - Circuit (a,c) (b,c)
  Swap :: Circuit (a,b) (b,a)
  AssocL :: Circuit ((a,b),c) (a,(b,c))
  AssocR :: Circuit (a,(b,c)) ((a,b),c)
  Loop :: Circuit (a,b) (a,c) - Circuit b c
  etc.

  Then we can have code that examines this concrete data representation,
 converts it to VHDL, optimizes it, etc.

  However, due to the presence of the opaque 'arr', there's no way to make
 this type an arrow without adding an 'escape hatch'
  Arr :: (a - b) - Circuit a b
  which breaks the abstraction: circuit is supposed to represent an actual
 boolean circuit; (Arr not) is not a valid circuit because we've lost the
 information about the existence of a 'Not' gate.

 If you require the circuit to be parametric in the value types, you can
 limit the types of function you can pass to arr to simple plumbing.
 See the netlist example at the end of my Fun of Programming slides (
 http://www.soi.city.ac.uk/~ross/papers/fop.html).
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Martin Hilbig

On 21.12.2012 01:23, Michael Sloan wrote:

Yeah, I've run into that too..

It does seem like there ought to be a better way, but in order to get
around that, I just define the imports (or generate) MyPrelude.hs in
the current directory.


what do you do with the file then? neither loadModules, setImports,
setTopLevelModules helped me :/

have fun
martin


That file can just consist of import
OtherPackage.MyPrelude.

-Michael


On Thu, Dec 20, 2012 at 4:12 PM, Martin Hilbig li...@mhilbig.de
mailto:li...@mhilbig.de wrote:

oh that's neat!

but what to do if MyPrelude is provided by some package?

i get this error:

   module `MyPrelude' is a package module

and neither

   set [languageExtensions := [PackageImports]]

nor

   {-# LANGUAGE PackageImports #-}

helps.

have fun
martin


On 21.12.2012 00:55, Michael Sloan wrote:

Hello!

Try doing this first:

loadModules [My.Module]

You may also need to set the searchPath - it defaults to the
current
director.  Another good function to know about is
setTopLevelModules,
which is just like using :load in ghci - it imports everything
in the
module, including its imports.  So, I often do:

loadModules [MyPrelude]
setTopLevelModules [MyPrelude]

And stick all of the things that I want to be in scope into
MyPrelude.hs.

-Michael


On Thu, Dec 20, 2012 at 3:35 PM, Martin Hilbig li...@mhilbig.de
mailto:li...@mhilbig.de
mailto:li...@mhilbig.de mailto:li...@mhilbig.de wrote:

 hi,

 how to use Language.Haskell.Interpreter.setImports?


 i use it like:

setImports [My.Module]

 so that my interpreted modules don't need to:

import My.Module

 But i still get:

Not in scope: data constructor `MyType'

 What am i doing wrong?

 Thanks in advance.

 have fun
 martin

 ___
 Haskell-Cafe mailing list
Haskell-Cafe@haskell.org mailto:Haskell-Cafe@haskell.org
mailto:Haskell-Cafe@haskell.__org
mailto:Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
http://www.haskell.org/__mailman/listinfo/haskell-cafe
 http://www.haskell.org/__mailman/listinfo/haskell-cafe
http://www.haskell.org/mailman/listinfo/haskell-cafe





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hint's setImports usage

2012-12-20 Thread Michael Sloan
Ahh, right!  Now that I think harder about it, as far as I know, there is
no way to get Hint to load a module with an extra import.  If it doesn't
hide the prelude, then one thing to try would be writing your own
./Prelude.hs file.  I'd test this, but I'm not currently on a computer
with GHC.

If this module is in a package, then there's definitely no way to give it
an extra import (it's already compiled).

Hope that helps!

-Michael



On Thu, Dec 20, 2012 at 5:02 PM, Martin Hilbig li...@mhilbig.de wrote:

 On 21.12.2012 01:23, Michael Sloan wrote:

 Yeah, I've run into that too..

 It does seem like there ought to be a better way, but in order to get
 around that, I just define the imports (or generate) MyPrelude.hs in
 the current directory.


 what do you do with the file then? neither loadModules, setImports,
 setTopLevelModules helped me :/

 have fun
 martin

  That file can just consist of import
 OtherPackage.MyPrelude.

 -Michael


 On Thu, Dec 20, 2012 at 4:12 PM, Martin Hilbig li...@mhilbig.de
 mailto:li...@mhilbig.de wrote:

 oh that's neat!

 but what to do if MyPrelude is provided by some package?

 i get this error:

module `MyPrelude' is a package module

 and neither

set [languageExtensions := [PackageImports]]

 nor

{-# LANGUAGE PackageImports #-}

 helps.

 have fun
 martin


 On 21.12.2012 00:55, Michael Sloan wrote:

 Hello!

 Try doing this first:

 loadModules [My.Module]

 You may also need to set the searchPath - it defaults to the
 current
 director.  Another good function to know about is
 setTopLevelModules,
 which is just like using :load in ghci - it imports everything
 in the
 module, including its imports.  So, I often do:

 loadModules [MyPrelude]
 setTopLevelModules [MyPrelude]

 And stick all of the things that I want to be in scope into
 MyPrelude.hs.

 -Michael


 On Thu, Dec 20, 2012 at 3:35 PM, Martin Hilbig li...@mhilbig.de
 mailto:li...@mhilbig.de
 mailto:li...@mhilbig.de mailto:li...@mhilbig.de wrote:

  hi,

  how to use Language.Haskell.Interpreter._**___setImports?



  i use it like:

 setImports [My.Module]

  so that my interpreted modules don't need to:

 import My.Module

  But i still get:

 Not in scope: data constructor `MyType'

  What am i doing wrong?

  Thanks in advance.

  have fun
  martin

  __**_

  Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org 
 mailto:Haskell-Cafe@haskell.**orgHaskell-Cafe@haskell.org
 
 mailto:Haskell-Cafe@haskell._**_org
 mailto:Haskell-Cafe@haskell.**org Haskell-Cafe@haskell.org
 
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe
 
 http://www.haskell.org/__**mailman/listinfo/haskell-cafehttp://www.haskell.org/__mailman/listinfo/haskell-cafe
 
  
 http://www.haskell.org/__**mailman/listinfo/haskell-cafehttp://www.haskell.org/__mailman/listinfo/haskell-cafe
 
 http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe
 **




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hoogle index completeness

2012-12-20 Thread Radical
Thanks for the suggestion, Jan. Is there a way to include all of hackage?

Alvaro


On Thu, Dec 20, 2012 at 3:37 AM, Jan Stolarek jan.stola...@p.lodz.plwrote:

  I see that the comments are from years ago. Are there any ongoing efforts
  to expand the default search set? (Or alternatively, to implement the
  +hackage modifier mentioned.)
 It's actually implemented as +nameOfLibrary. Hoogling for rstrip
 +missingh gives:

 rstrip :: String - String
 MissingH Data.String.Utils
 Same as strip, but applies only to the right side of the string.

 Janek

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread ok
 I've perhaps been trying everyones patiences with my noobish CT
 questions, but if you'll bear with me a little longer: I happened to
 notice that there is in fact a Category class in Haskell base, in
 Control.Category:

 quote:
 
 class Category cat where

 A class for categories. id and (.) must form a monoid.

 Methods

 id :: cat a a

This says that 'cat' must be a type constructor with two
type arguments.  In an instance of this type, a and b will
refer to objects of the category and cat a b to the morphisms.

Integer is NOT a type constructor with two type arguments,
so instance Category Integer makes no sense.

[] is a type constructor with one type argument,
not two, so instance Category [] makes no sense either.

Can you make Either an instance of Category?
Can you make (,) an instance of Category?
Can you make (a copy of) - an instance of Category a different way?



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] category design approach for inconvenient concepts

2012-12-20 Thread Alexander Solla
On Thu, Dec 20, 2012 at 12:53 PM, Oleksandr Manzyuk manz...@gmail.comwrote:

 I have no problems with the statement Objects of the category Hask
 are Haskell types.  Types are well-defined syntactic entities.  But
 what is a morphism in the category Hask from a to b?  Commonly, people
 say functions from a to b or functions a - b, but what does that
 mean?  What is a function as a mathematical object?  It is a plausible
 idea to say that a function from a to b is a closed term of type a -
 b (and terms are again well-defined syntactic entities).  How do we
 define composition?  Presumably, by

 f . g = \x - f (g x)

 This however already presupposes that we are dealing not with raw
 terms, but with their alpha-equivalence classes (otherwise the above
 is not well-defined as it depends on the choice of the variable x).
 Even if we mod out alpha-equivalence, so defined composition fails to
 be associative on the nose, up to equality of (alpha-equivalence
 classes of) terms.  Apparently, we want to consider equivalence
 classes of terms modulo some finer equivalence relation.  What is this
 equivalence relation?  Some kind of definitional equality?


I don't see how associativity fails, if we mod out alpha-equivalence.  Can
you give an example?  (If it involves the value undefined, I'll have
something concrete to add vis a vis moral equivalence)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Jay Sulzberger



On Thu, 20 Dec 2012, Christopher Howard christopher.how...@frigidcode.com 
wrote:


On 12/20/2012 03:59 AM, wren ng thornton wrote:

On 12/20/12 6:42 AM, Christopher Howard wrote:

As mentioned in my other email (just posted) the kind mismatch is
because categories are actually monoid-oids[1] not monoids. That is:

class Monoid (a :: *) where
mempty  :: a
mappend :: a - a - a

class Category (a :: * - * - *) where
id  :: a i j
(.) :: a j k - a i j - a i k

Theoretically speaking, every monoid can be considered as a category
with only one object. Since there's only one object/index, the types for
id and (.) basically degenerate into the types for mempty and mappend.
Notably, from this perspective, each of the elements of the carrier set
of the monoid becomes a morphism in the category--- which some people
find odd at first.

In order to fake this theory in Haskell we can do:

newtype MonoidCategory a i j = MC a

instance Monoid a = Category (MonoidCategory a) where
id  = MC mempty
MC f . MC g = MC (f `mappend` g)

This is a fake because technically (MonoidCategory A X Y) is a different
type than (MonoidCategory A P Q), but since the indices are phantom
types, we (the programmers) know they're isomorphic. From the category
theory side of things, we have K*K many copies of the monoid where K is
the cardinality of the kind *. We can capture this isomorphism if we
like:

castMC :: MonoidCategory a i j - MonoidCategory a k l
castMC (MC a) = MC a

but Haskell won't automatically insert this coercion for us; we gotta do
it manually. In more recent versions of GHC we can use data kinds in
order to declare a kind like:

MonoidCategory :: * - () - () - *

which would then ensure that we can only talk about (MonoidCategory a ()
()). Unfortunately, this would mean we can't use the Control.Category
type class, since this kind is more restrictive than (* - * - * - *).
But perhaps in the future that can be fixed by using kind polymorphism...


[1] The -oid part just means the indexing. We don't use the term
monoidoid because it's horrific, but we do use a bunch of similar
terms like semigroupoid, groupoid, etc.



Finally... I actually made some measurable progress, using these
phantom types you mentioned:

code:

import Control.Category

newtype Product i j = Product Integer

 deriving (Show)

instance Category Product where

 id = Product 1

 Product a . Product b = Product (a * b)


I can do composition, illustrate identity, and illustrate associativity:

code:

h Product 5  Product 2
Product 10

h Control.Category.id (Product 3)
Product 3

h Control.Category.id  Product 3
Product 3
h Product 3  Control.Category.id
Product 3

h (Product 2  Product 3)  Product 5
Product 30
h Product 2  (Product 3  Product 5)
Product 30



Thank you for this code!

What does the code for going backwards looks like?  That is,
suppose we have an instance of Category with only one object.
What is the Haskell code for the function which takes the
category instance and produces a monoid thing, like your integers
with 1 and usual integer multiplication?  Could we use a
constraint at the level of types, or at some other level, to
write the code?  Here by constraint I mean something like a
declaration that is a piece of Haskell source code, and not
something the human author of the code uses to write the code.

Maybe Categorical Programming for Data Types with Restricted
Parametricity by D. Orchard and Alan Mycroft

  http://www.cl.cam.ac.uk/~dao29/drafts/tfp-structures-orchard12.pdf

has something to do with this.

oo--JS.




--
frigidcode.com




___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Gershom Bazerman

On 12/20/12 10:05 PM, Jay Sulzberger wrote:

What does the code for going backwards looks like?  That is,
suppose we have an instance of Category with only one object.
What is the Haskell code for the function which takes the
category instance and produces a monoid thing, like your integers
with 1 and usual integer multiplication?  Could we use a
constraint at the level of types, or at some other level, to
write the code?  Here by constraint I mean something like a
declaration that is a piece of Haskell source code, and not
something the human author of the code uses to write the code.

instance C.Category k = Monoid (k a a) where
mempty = C.id
mappend = (C..)

The above gives witness to the fact that, if I'm using the language 
correctly, if we choose any object (our a) in any given category, this 
induces a monoid with the identity morphism as unit and composition of 
endomorphisms as append.


The standard libraries in fact provide this instance for the function 
arrow category (under a newtype wrapper):


newtype Endo a = Endo { appEndo :: a - a }

instance Monoid (Endo a) where
mempty = Endo id
Endo f `mappend` Endo g = Endo (f . g)

--Gershom
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Categories (cont.)

2012-12-20 Thread Jay Sulzberger



On Thu, 20 Dec 2012, Gershom Bazerman gersh...@gmail.com wrote:


On 12/20/12 10:05 PM, Jay Sulzberger wrote:

What does the code for going backwards looks like?  That is,
suppose we have an instance of Category with only one object.
What is the Haskell code for the function which takes the
category instance and produces a monoid thing, like your integers
with 1 and usual integer multiplication?  Could we use a
constraint at the level of types, or at some other level, to
write the code?  Here by constraint I mean something like a
declaration that is a piece of Haskell source code, and not
something the human author of the code uses to write the code.

instance C.Category k = Monoid (k a a) where
   mempty = C.id
   mappend = (C..)

The above gives witness to the fact that, if I'm using the language 
correctly, if we choose any object (our a) in any given category, this 
induces a monoid with the identity morphism as unit and composition of 
endomorphisms as append.


The standard libraries in fact provide this instance for the function arrow 
category (under a newtype wrapper):


newtype Endo a = Endo { appEndo :: a - a }

instance Monoid (Endo a) where
   mempty = Endo id
   Endo f `mappend` Endo g = Endo (f . g)

--Gershom


Thanks, Gershom!

I think I see.  The Haskell code picks out the
isotropy/holonomy monoid at the object a of any Haskell
Category instance.

actual old fashioned types remark: To get the holonomy
semigroup^Wmonoid, interpolate a functor.

I am glad that Haskell today smoothly handles this.

ad paper on polymorphisms: I hope to post a rant against the
misleading distinction between parametric polymorphism and ad
hoc polymorphism.  Lisp will be used as a bludgeon in the only
argument in the rant.  The Four Things Which Must Be
Distinguished will perform the opening number.

oo--JS.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] monoid pair of monoids?

2012-12-20 Thread Christopher Howard
In my current pondering of the compose-able objects them, I was thinking
it would be useful to have the follow abstractions: Monoids, which were
themselves tuples of Monoids. The idea was something like so:

code:

import Data.Monoid

instance Monoid (Socket2 a b) where

  mempty = Socket2 (mempty, mempty)

  Socket2 (a, b) `mappend` Socket2 (w, x) = Socket2 (a `mappend` w, b
`mappend` x)

data Socket2 a b = Socket2 (a, b)


However, this does not compile because of errors like so:

code:

Sockets.hs:9:21:
No instance for (Monoid a)
  arising from a use of `mempty'
In the expression: mempty
In the first argument of `Socket2', namely `(mempty, mempty)'
In the expression: Socket2 (mempty, mempty)


This makes sense, but I haven't figured out a way to rewrite this to
make it work. One approach I tried was to encode Monoid constraints into
the data declaration (which I heard was a bad idea) but this didn't
work, even using forall. Also I tried to encode it into the instance
declaration, but the compiler kept complaining about errant or illegal
syntax.

-- 
frigidcode.com



signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] monoid pair of monoids?

2012-12-20 Thread Daniel Feltey
Is Socket2 a b any different from the pair (a,b)?

Assuming Socket2 looks roughly like the following:

 import Data.Monoid
 data Socket2 a b = Socket2 (a,b)

Then if both a and b are instances of Monoid we can make Socket2 a b into
an instance of Monoid the same way we make (a,b) into a Monoid.


 instance (Monoid a, Monoid b) = Monoid (Socket a b) where
 mempty = Socket2 (mempty, mempty)
 Socket2 (a, b) `mappend` Socket2 (w, x) = Socket2 (a `mappend` w, b 
 `mappend`
x)

You were only missing the restriction that both types a and b must be
instances of Monoid in order to make Socket a b into an instance of Monoid.



Dan Feltey



On Thu, Dec 20, 2012 at 8:40 PM, Christopher Howard 
christopher.how...@frigidcode.com wrote:

 In my current pondering of the compose-able objects them, I was thinking
 it would be useful to have the follow abstractions: Monoids, which were
 themselves tuples of Monoids. The idea was something like so:

 code:
 
 import Data.Monoid

 instance Monoid (Socket2 a b) where

   mempty = Socket2 (mempty, mempty)

   Socket2 (a, b) `mappend` Socket2 (w, x) = Socket2 (a `mappend` w, b
 `mappend` x)

 data Socket2 a b = Socket2 (a, b)
 

 However, this does not compile because of errors like so:

 code:
 
 Sockets.hs:9:21:
 No instance for (Monoid a)
   arising from a use of `mempty'
 In the expression: mempty
 In the first argument of `Socket2', namely `(mempty, mempty)'
 In the expression: Socket2 (mempty, mempty)
 

 This makes sense, but I haven't figured out a way to rewrite this to
 make it work. One approach I tried was to encode Monoid constraints into
 the data declaration (which I heard was a bad idea) but this didn't
 work, even using forall. Also I tried to encode it into the instance
 declaration, but the compiler kept complaining about errant or illegal
 syntax.

 --
 frigidcode.com


 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hoogle index completeness

2012-12-20 Thread Jan Stolarek
Dnia piątek, 21 grudnia 2012, Radical napisał:
 Thanks for the suggestion, Jan. Is there a way to include all of hackage?
Sorry, I don't know any way of doing this. 

Janek

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe