Re: Records in Haskell: Explicit Classy Records

2012-04-23 Thread Strake
On 22/04/2012, AntC anthony_clay...@clear.net.nz wrote:
 Matthew Farkas-Dyck strake888 at gmail.com writes:

 I made another proposal for records in Haskell, meant to solve just
 the namespace problem, and no more.
 http://hackage.haskell.org/trac/ghc/wiki/Records/ExplicitClassyRecords


 Thanks Matthew, I'm finding your wiki too sketchy to follow.

 What name(s) does your proposal generate? And what type(s) do they have?

Ahh, this is partly the beauty of it — it generates no names. All
names are user-declared. The system generates only instances.

 For record access, how does the compiler resolve to the right definition or
 instance from the context of use?

Just as it would any other. It's simply a type class.

 It seems you aren't making any proposal about record updating. So the acid
 test is how do you expect this to be treated:
  e{ x = True }
 {* `e` is some arbitrary expression, possibly denoting a record type;
`x` one of those names for which you've solved the namespace problem
 *}

Ah, sorry; I added this to the wiki.

Cheers,
strake

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: default instance for IsString

2012-04-23 Thread Yitzchak Gale
Jeremy Shaw wrote:
 I have often wished for something like:
 {-# LANGUAGE StringLiteralsAs Text #-}
 where all string literals like:
 f = foo
 would be translated to:
 f = (fromString foo :: Text)

Agreed, I would also really like this.

 I find that OverloadedStrings is too general and causes ambiguous type
 errors. Additionally, I seldom find that I have more than one type of
 string literal per file. Things tend to be all String, all Text, etc.
 So, if I could just pick a concrete type for all the string literals
 in my file, I would be happy.

In addition, OverloadedStrings is unsound. Library authors can,
and do, write unsafe implementations of IsString that cause
syntax errors to be caught only at run time instead of at
compile time. That is the opposite of one of the most
important things we are trying to accomplish by using
Haskell instead of, say, some dynamically typed language.

Greg Weber wrote:
 You can default a String. So this compiles just fine:

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExtendedDefaultRules #-}
 import Data.Text as T
 default (T.Text)

No, I do not want string literals to be polymorphic, even
if there is some kind of defaulting. I want them to be
monomorphic, as they always have been. But I still
want to be able to specify to the compiler somehow
that the monomorphic type for string literals in a
particular module should be something other than
String.

Thanks,
Yitz

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: default instance for IsString

2012-04-23 Thread Greg Weber
On Mon, Apr 23, 2012 at 9:58 AM, Yitzchak Gale g...@sefer.org wrote:
 Jeremy Shaw wrote:
 I have often wished for something like:
     {-# LANGUAGE StringLiteralsAs Text #-}
 where all string literals like:
     f = foo
 would be translated to:
     f = (fromString foo :: Text)

 Agreed, I would also really like this.

 I find that OverloadedStrings is too general and causes ambiguous type
 errors. Additionally, I seldom find that I have more than one type of
 string literal per file. Things tend to be all String, all Text, etc.
 So, if I could just pick a concrete type for all the string literals
 in my file, I would be happy.

 In addition, OverloadedStrings is unsound. Library authors can,
 and do, write unsafe implementations of IsString that cause
 syntax errors to be caught only at run time instead of at
 compile time. That is the opposite of one of the most
 important things we are trying to accomplish by using
 Haskell instead of, say, some dynamically typed language.

 Greg Weber wrote:
 You can default a String. So this compiles just fine:

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExtendedDefaultRules #-}
 import Data.Text as T
 default (T.Text)

 No, I do not want string literals to be polymorphic, even
 if there is some kind of defaulting. I want them to be
 monomorphic, as they always have been. But I still
 want to be able to specify to the compiler somehow
 that the monomorphic type for string literals in a
 particular module should be something other than
 String.

 Thanks,
 Yitz

Hi Yitz,

I very much agree with you. However, when we complain about something
essentially we are asking others to prioritize it ahead of other
things. I don't think any more visibility of this issue is going to
improve its prioritization. I suspect your only way forward right now
is to start implementing something yourself.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: default instance for IsString

2012-04-23 Thread Greg Weber
The defaulting is very good for most use cases, however I am
discovering it won't default when I try to build up a list or tuple.
This does not work:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleInstances #-}
module Default (noDefault) where
import Data.Text as T
default (T.Text)

classNoDefault awhere noDefault :: a - [Text]
instance NoDefault [T.Text] where noDefault = id

main = print (noDefault [Hello!])

On Sun, Apr 22, 2012 at 8:31 PM, Greg Weber g...@gregweber.info wrote:
 Sorry, someone responded on haskell-cafe and the message didn't get
 sent here. You can default a String. So this compiles just fine:

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExtendedDefaultRules #-}
 import Data.Text as T
 default (T.Text)

 class    NoDefault a      where noDefault :: a - Text
 instance NoDefault T.Text where noDefault = id

 main = print (noDefault Hello!)

 On Sun, Apr 22, 2012 at 1:57 PM, Jeremy Shaw jer...@n-heptane.com wrote:
 I have often wished for something like:

 {-# LANGUAGE StringLiteralsAs Text #-}

 where all string literals like:

 f = foo

 would be translated to:

 f = (fromString foo :: Text)

 I find that OverloadedStrings is too general and causes ambiguous type
 errors. Additionally, I seldom find that I have more than one type of
 string literal per file. Things tend to be all String, all Text, etc.
 So, if I could just pick a concrete type for all the string literals
 in my file, I would be happy.

 - jeremy



 On Sat, Apr 21, 2012 at 7:20 PM, Greg Weber g...@gregweber.info wrote:
 I would like to default IsString to use the Text instance to avoid
 ambiguous type errors.
 I see defaulting capability is available for Num. Is there any way to
 do this for IsString?

 Thanks,
 Greg Weber

 ___
 Glasgow-haskell-users mailing list
 Glasgow-haskell-users@haskell.org
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: default instance for IsString

2012-04-23 Thread J. Garrett Morris
On Mon, Apr 23, 2012 at 9:58 AM, Yitzchak Gale g...@sefer.org wrote:
 In addition, OverloadedStrings is unsound.

No.  OverloadedStrings treats string literals as applications of
fromString to character list constants.  fromString can throw errors,
just like fromInteger; this is no less sound than any Haskell function
throwing an exception.

 /g


--
Would you be so kind as to remove the apricots from the mashed potatoes?

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: default instance for IsString

2012-04-23 Thread Bas van Dijk
On 23 April 2012 20:34, J. Garrett Morris jgmor...@cs.pdx.edu wrote:
 On Mon, Apr 23, 2012 at 9:58 AM, Yitzchak Gale g...@sefer.org wrote:
 In addition, OverloadedStrings is unsound.

 No.  OverloadedStrings treats string literals as applications of
 fromString to character list constants.  fromString can throw errors,
 just like fromInteger; this is no less sound than any Haskell function
 throwing an exception.

But it would be safer if those errors were moved to compile time by
treating overloaded literals as Template Haskell splices. As in:

1

would be translated to:

$(fromIntegerLit 1)

where:

class FromIntegerLit a where
  fromIntegerLit :: Integer - Q (Exp a)

(this assumes that Exp is parameterized by the type of the value it
splices to which is currently not the case. However you can work
around this by using a Proxy or Tagged value.)

An instance for Integer is trivial:

instance FromIntegerLit Integer where
  fromIntegerLit = litE . integerL

The extra safety comes when giving an instance for natural numbers, for example:

newtype Nat = Nat Integer

instance FromIntegerLit Nat where
  fromIntegerLit n
  | n  0 = error Can't have negative Nats
  | otherwise = 'Nat `appE` fromIntegerLit n

Note that the error will be thrown at compile time when the user has
written a negative Nat literal.

Regards,

Bas

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users