[Haskell-cafe] Re: Set Operations In Haskell's Type System

2010-05-07 Thread John Creighton


On May 6, 4:30 am, Bartek Ćwikłowski paczesi...@gmail.com wrote:
 hello,

 2010/5/6 John Creighton johns2...@gmail.com:

  a isa d if their exists a b and c such that the following
  conditions hold:

  a isa subset of b,
  b isa c
  c is a subset of d

 This definition doesn't make sense - it's recursive, but there's no
 base case, unless this is some kind of co-recursion.

 Are you sure that subset isn't what you really want? With subset you
 can already ask questions such as is tabby cat an animal?. If so, my
 code (from hpaste) already has this (iirc isDescendentOf ).

When I succeed in implementing it I'll show you the result. Anyway,
some perspective (perhaps), I once asked, what is the difference
between a subset and an element of a set:

http://www.n-n-a.com/science/about33342-0-asc-0.html

It sounds like a strange question but is a cat a subset of noun? Cat
is relay just a word or a label, we could be referring to the word
Cat, The set of all Cats or a particular cat. If by Nouns we mean
physical things then the set of cats is a subset of the set of things
that are nouns. However, if by noun we mean a type of word, then cat
is not a type or word but noun is a type of word. From the perspective
of programing the latter observation seems more useful. It involves
some context in that we wish to treat word types and instances of
those word types differently rather then trying to fit them into some
homogeneous hierarchy.

For instance if we are building grammar parsing rules then we probably
only care what type or word or phrase something is and any
hierarchical relationship beyond that are not relevant to the context
of parsing. Now if our goal is only to parse then perhaps their is a
better approach but object oriented programing has shown how subclass
polymorphism adds some level of abstraction and helps to make code
more generic. Haskel's type system allows for even more generic
approaches.

To summarize, I have chosen to define isa as a relationship between
hierarchies, while subset/superset are our standard heiercrical view
of the world (e.g. animal kingdom). Now with regards to my definition,
let's go further. Let's create an equivalence between a noun phrase of
length one and a Noun.

http://en.wikipedia.org/wiki/Noun_phrase

while we may wish to view the noun as primitive, with regards to
meaning the phrase narrows the scope of the noun.

For instance big cat, means that cat can no longer refer to all cats
but the cats must be big.

Now if we want to know if big cat is a noun, it is enough to know
that, big cat is a subset of cat, cat is a common noun, and common
noun is a subset of noun. (I'm aware some may object to big cat being
a noun but big cat is a thing and a noun is a thing).


This keeps us from directly having to program a direct relationship
between big cat and noun. One of the goals of AI is to minimize what
we have to tell our system in order to solve a problem. This is
referred to as the A to I ratio. Generic programing has this
characteristic in that our code is widely applicable. The isa rule
above makes code more generic in that we are now able to write
functions four nouns which will apply to say big cat with out even
having to tell our program that big cat is a noun, rather it can
directly infer it from the rules we supplied.

--
note 1) Okay I'm aware some will argue my definitions here and if it
helps I could choose new words, the only question really is, is the
relationship isa which I described a useful abstraction. I think it is
and weather it is or not would of course depend on if it reduces the
amount of code that needs to be written and it produces the correct
results. We could create other relationships which embody what other
people think a useful isa function should do and they could be used
either in parallel with my relationship or with a completely different
approach. I cannot say weather such alternative relationships will be
more or less useful.

note2 ) For the purpose of the above I guess we can define Noun to be
a noun phrase of length one (we can choose a different word if someone
prefers to call this instead of a noun.),

note 3) Anyway, with regards to the above I am using subset with
regards to scope (the number of _ something can refer to) and isa
with regards to type of scope. So noun says the scope refers to a
person place or thing and then, the noun (or noun phrase) limits the
scope of these things that the phrase/noun can refer to. This is
perhaps not the standard English/linguistic usage and I am sure their
are many reasonable objections to the above on semantic grounds. I am
not interested in a debate on semantics but will listen to suggestions
for alternative terms/definitions.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Dynamic CSV Parsing - Parsec

2010-05-07 Thread Bernd Holzmüller
Hi Günther,

A simple method is to parameterize a parse function by something you
parsed previously.
For the example you gave, I would try something like this:

import ParseToken

cellContent = do ... -- parses the contents of a cell

cvsParser = do
  headings - sepBy identifier semi
  cs - count (length headings - 1) (do c - cellContent; semi; return c)
  c - cellContent
  return (cs ++ [c])

Of course, you can put the last two lines into a separate function that
is parameterized with the list of headings found.
(Instead of these lines, I would also define an abstraction function
sepByCount p n sep that parses n occurrences of p, each separated by sep.)

Best regards,
Bernd

Am 07.05.2010 00:40, schrieb Günther Schmidt:
 Hello,

 I'm trying to build a CSV parser that can dynamically assemble a
 parser from the values of the first line.

 As the most simple example the parse of the first line would return a
 parser with which subsequent lines would then be parsed.
 This parser would, for instance, only parse lines with the exact
 number of columns as found in the first line.

 Where I eventually want to go is a bit more complicated than this, but
 for now I'd be grateful for suggestions on how to go about the simple
 case.

 Best regards

 Günther


 ___
 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] darcs to mercurial migration

2010-05-07 Thread Nicolas Pouillard
On Thu, 06 May 2010 01:08:08 +0200, Günther Schmidt gue.schm...@web.de wrote:
 Hello,
 
 I'm switching from darcs to mercurial with some of my projects.
 
 I'd like to retain as much of the history as possible, what tools are 
 there available for this?

I recommend you darcs-fast-export and then use the/a mercurial fast-import.

http://vmiklos.hu/project/darcs-fast-export/

Regards,

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


[Haskell-cafe] Mirror repository for gtk2hs

2010-05-07 Thread Andy Stewart
Hi all,

Because code.haskell.org is unstable recently,
and many gtk2hs users can't get code from http://code.haskell.org/gtk2hs

So i build a mirror repository at 
http://patch-tag.com/r/AndyStewart/gtk2hs-sync-mirror/home
You can access this mirror repository when code.haskell.org down.

This mirror repository synchronous http://code.haskell.org/gtk2hs
Hourly.

Because mirror repository just read-only, please send any patches to
gtk2hs main repository (http://code.haskell.org/gtk2hs)

I need thanks Thomas Hartman (the administor of patch-tag.com), i
can't build this mirror repository if haven't his help.
Thanks Thomas!

Enjoy, everybody!

  -- Andy



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


Re: [Haskell-cafe] Database connection pool

2010-05-07 Thread Michael Snoyman
On Fri, May 7, 2010 at 1:02 AM, Bas van Dijk v.dijk@gmail.com wrote:

 On Thu, May 6, 2010 at 11:54 PM, Bas van Dijk v.dijk@gmail.com
 wrote:
  On Thu, May 6, 2010 at 7:48 PM, Bas van Dijk v.dijk@gmail.com
 wrote:
  On Thu, May 6, 2010 at 3:24 PM, Michael Snoyman mich...@snoyman.com
 wrote:
 
 
  On Thu, May 6, 2010 at 9:13 AM, Bryan O'Sullivan b...@serpentine.com
 wrote:
 
  On Wed, May 5, 2010 at 10:51 PM, Michael Snoyman mich...@snoyman.com
 
  wrote:
 
  * When a connection is released, is goes to the end of the pool, so
  connections get used evenly (not sure if this actually matters in
 practice).
 
  In practice, you're better off letting idle connections stay that way,
  because then your DB server can close connections and free up
 resources. In
  other words, when you're done with a connection, put it at the front
 of the
  reuse queue, not the back.
  You'll also want to handle the possibility that a connection that you
 grab
  from the pool has been closed by the server. Many connection pooling
  implementations I've seen get this wrong in subtle or expensive ways.
 
  Thanks for the feedback. I've gone ahead and implemented a simple
 resource
  pool module. Since I need it to work with monad transformer stacks,
 I've
  built it on top of MonadCatchIO-transformers. I've put the code up in a
 gist
  on github[1]. I would appreciate if anyone could review this,
 especially to
  make sure the exception handling code is correct. block and unblock in
  particular concern me.
  Thanks,
  Michael
  [1] http://gist.github.com/392078
 
  I also have a suggestion for your design. (Note however that I don't
  have much experience with resource pools.)
 
  In your current design a Pool has a fixed maximum number of opened
  resources. I can imagine situations where the maximum number of opened
  resources can change dynamically. For example due to plugging in (or
  out) a new blade server at run-time which will increase (or decrease)
  the maximum number of resources that can be handled.
 
  So what about changing:
 
  createPool :: IO a - Int - IO (Pool a)
  to:
  createPool :: IO (Maybe a) - IO (Pool a)
 
  so, instead of statically storing the maximum number of  opened
  resources (Int), the resource creation function will decide itself
  when it has created enough (Maybe a).
 
  Regards,
 
  Bas
 
 
  How about something like this:
 
 
 
  {-# LANGUAGE NoImplicitPrelude #-} -- (I like to be explicit)
 
  module Pool (Pool, new, withPool) where
 
  import Data.Function   ( ($), (.) )
  import Data.Maybe  ( Maybe(Nothing,Just), maybe )
  import Data.Functor( ($) )
  import Control.Monad   ( return, (=), (), (=), fail,
  join, liftM )
  import Control.Monad.STM   ( atomically )
  import Control.Concurrent.STM.TVar ( TVar, newTVarIO, readTVar, writeTVar
 )
  import Control.Monad.CatchIO   ( MonadCatchIO, block, finally )
  import Control.Monad.IO.Class  ( liftIO )
 
  newtype Pool r = Pool (TVar [r])
 
  new :: MonadCatchIO m = m (Pool r)
  new = liftIO $ Pool $ newTVarIO []
 
  withPool :: MonadCatchIO m = Pool r - m (Maybe r) - (r - m a) - m
 (Maybe a)
  withPool (Pool tv) mk f = block $ join $ liftIO $ atomically $ do
   rrs - readTVar tv
   case rrs of
 [] - return $ mk = maybe (return Nothing) with
 r:rs - writeTVar tv rs  return (with r)
 where
   with r = liftM Just (f r)
 `finally`
   liftIO (atomically $ writeTVar tv . (r:) = readTVar
 tv)
 
 
 
  Note that I don't store the resource creation action (m (Maybe r))
  inside the pool. It's just passed as an argument to withPool.
 
  Regards,
 
  Bas
 

 Note that it's probably better to pass the resource creation action as
 the first argument to withPool:

 withPool :: MonadCatchIO m = m (Maybe r) - Pool r - (r - m a) - m
 (Maybe a)

 This way it's easier to create specialized withPool functions by
 partially applying a specific resource creation action to withPool as
 in:

 withDBConsPool :: MonadCatchIO m = Pool DBCon - (DBCon - m a) - m
 (Maybe a)
 withDBConsPool = withPool connectWithDB

 Regards,

 Bas


Bas,

Thank you for all the very thorough comments. If I'm understanding
correctly, there are two categories of suggestion:

1) Make the resource exhaustion mechanism more extensible.
2) Avoid wormholes

Please tell me if I've missed something.

Regarding (1), I think your approach is definitely better for complex pools;
however, for the usually case, I think it would present a more difficult API
for users. I could definitely imagine wrapping an easier-to-use interface
around your final example.

Regarding (2), I was not aware of it, thank you for updating me on the
issue.

So, here's my idea of how to wrap your Pool module to provide a simple

Re: [Haskell-cafe] ANNOUNCE: gt-tools-0.1.4

2010-05-07 Thread Max Rabkin
On Fri, May 7, 2010 at 4:12 AM, Felipe Lessa felipe.le...@gmail.com wrote:
 On Thu, May 06, 2010 at 09:30:50PM +0300, Sergei Trofimovich wrote:
 /me wonders if Miss lambdabot might like to have such functionality.
 What do you think?

 Do the terms of use of Google Translate allow it?

I can't remember, but they try to block it. However, there is a public API.

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


[Haskell-cafe] Re: [Long, probably not-beginners anymore] Parallel folds and folds as arrows (was: Re: [Haskell-beginners] Re: When, if ever, does Haskell calculate once?)

2010-05-07 Thread Daniel Fischer
On Friday 07 May 2010 03:15:19, Maciej Piechotka wrote:
 On Thu, 2010-05-06 at 23:46 +0200, Daniel Fischer wrote:
  Share.share :: GHC.Types.Int
  GblId
  [Str: DmdType]
  Share.share =
case GHC.List.$wlen @ GHC.Integer.Type.Integer Share.share_a 0
of ww_amc { __DEFAULT -
GHC.Types.I# (GHC.Prim.+# ww_amc ww_amc)
}

 Hmm. What's the name of this form and how to get it?


It's GHC's intermediate language, named Core. It's sort of a slimmed down 
Haskell.
You can get it by
a) compiling with the -ddump-simpl flag
(e.g. ghc -O2 -ddump-simpl --make prog  prog.core
If you don't redirect, it's spat out to stdout, better to have it in a file 
for reading. Also, it's easier to read with syntax-highlighting, plain 
Haskell-highlighting already goes a long way.)
b) using Don Stewart's ghc-core (http://hackage.haskell.org/package/ghc-
core), e.g. ghc.core -f html -- -O2 Source.hs  Source.html

Looking at the core, you can see what GHC really makes from your code.

  No.
 
  cFoldl' f g (b0,c0) xs0 = lgo b0 c0 xs0
  where
lgo b c [] = (b,c)
lgo !b !c (x:xs) = lgo (f b x) (g c x) xs

 Ok. Fixed (I tried fast rewrite from foldr')


Doesn't matter when compiled with optimisations (produces nearly identical 
core), but without optimisations the original constructs a new pair in each 
step.

However, I inadvertently swapped the clauses of lgo (could also be fixed by 
putting the bang patterns in the first clause). That didn't matter as long 
as both accumulating functions were lengthFold, but it makes a big 
difference when one is (+).

  64-bit system? I get

 64 bit, GHC 6.12.2.
 % ghc -V
 The Glorious Glasgow Haskell Compilation System, version 6.12.2
 % file a.out
 a.out: ELF 64-bit LSB executable, x86-64, version 1 (SYSV), dynamically
 linked (uses shared libs), for GNU/Linux 2.6.9, not stripped

  And that is strange, because I get the same figures for that one as
  for the first (times differ by a few hundredths of a second).

 Fixed or non-fixed version?

  Is that a difference between 32-bit code generator and 64-bit or
  between GHC versions (6.12.2 here, but 6.10.3 gives roughly the same
  results)?

 Hmm. Compiler and platform matches. Unless you use some other 64-bit
 platform - not x86-64 ;)

No, I have a 32-bit system (I got almost exactly half the allocation 
figures you got, so I suspected your Ints [and small Integers] were twice 
as large as mine).


main =
  print $! uncurry (+) (cFoldl' lengthFold lengthFold
(0, 0) [1..size])
 
  And that gives the same figures as the other two (plus/minus 0.05s).
 
   All are compiled with optimizations.
 
  All compiled with -O2.

 Hmm. Difference between -O1 and -O2


No, they produce identical core for these.

 Fixed versions and with sum (and -O2):
  main = let a = [1..size]
 l = length a + sum a
 in print $! l

 Lot's of memory(Over 3 GiB). I voluntarily killed process


Yes, of course.

  main = print $! length [1..size] + sum [1..size]

 Lot's of memory(Over 3 GiB). I voluntarily killed process.

 So far as being inplace.


Yes. Actually, with optimisations turned on, GHC *does* share the list 
[1 .. size]. Oops.
It's not shared with -O0 unless you give it a name.

  main = print $! uncurry (+) (cFoldl' lengthFold (+) (0, 0) [1..size])

 50015000
   16,889,753,976 bytes allocated in the heap
3,356,480 bytes copied during GC
1,976 bytes maximum residency (1 sample(s))
   28,200 bytes maximum slop
1 MB total memory in use (0 MB lost due to fragmentation)

   Generation 0: 32216 collections, 0 parallel,  0.29s,  0.38s
 elapsed
   Generation 1: 1 collections, 0 parallel,  0.00s,  0.00s
 elapsed

   INIT  time0.00s  (  0.00s elapsed)
   MUT   time   14.89s  ( 15.12s elapsed)
   GCtime0.29s  (  0.38s elapsed)
   EXIT  time0.00s  (  0.00s elapsed)
   Total time   15.18s  ( 15.50s elapsed)

   %GC time   1.9%  (2.4% elapsed)

   Alloc rate1,134,094,110 bytes per MUT second

   Productivity  98.1% of total user, 96.1% of total elapsed

 ./a.out +RTS -s  15.18s user 0.11s system 98% cpu 15.503 total

With the really fixed cFoldl' (overflows of course):

./lsCFoldl +RTS -s 
1087459712 
   4,015,621,900 bytes allocated in the heap   
 126,564 bytes copied during GC
   1,460 bytes maximum residency (1 sample(s)) 
  29,892 bytes maximum slop
   1 MB total memory in use (0 MB lost due to fragmentation)

  Generation 0:  7659 collections, 0 parallel,  0.07s,  0.05s elapsed
  Generation 1: 1 collections, 0 parallel,  0.00s,  0.00s elapsed

  INIT  time0.00s  (  0.00s elapsed)
  MUT   time1.50s  (  1.54s elapsed)
  GCtime0.07s  (  0.05s elapsed)
  EXIT  time

[Haskell-cafe] Re: [Long, probably not-beginners anymore] Parallel folds and folds as arrows (was: Re: [Haskell-beginners] Re: When, if ever, does Haskell calculate once?)

2010-05-07 Thread Daniel Fischer
On Friday 07 May 2010 16:15:41, Daniel Fischer wrote:
 b) using Don Stewart's ghc-core (http://hackage.haskell.org/package/ghc-
 core), e.g. ghc.core -f html -- -O2 Source.hs  Source.html

And of course, the html backend of ghc-core was removed with version 0.5 :(
If you want html output,
$ cabal install --constraint=hscolour == 1.13 ghc-core-0.4.3
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] accents

2010-05-07 Thread Dupont Corentin
Hello,
i'm still struggling with ghci and accents.

Prelude é
\233

I've installed GHC 6.12.1, which gave me a better result:

Prelude putStrLn é
é

but still:

Prelude é
\233

I'm trying to search a file with french words with Regex, but i
stumble on accents:

*Main findRegexFile abnégation
[]
*Main findRegexFile abn.gation
[abn\218gation,abn\218gations]


I don't know the encoding of my file, how to deduce it?
What is the encoding used by ghci? Unicode?
Its seems not be the same since the représentation for é is not the
same (\233 and \218).
How to have accented characters in ghci? Can't find any ressources on the net.

Cheers,
Corentin

PS: please let me know is you can't see the accented characters in
this email, i'll send you another version with pictures.


On 3/24/10, Ivan Lazar Miljenovic ivan.miljeno...@gmail.com wrote:
 Dupont Corentin corentin.dup...@gmail.com writes:
 a - readFile list.txt
 head $ lines a
 abn\233gation

 putStrLn displays a strange character for the é.

 That is the escaped form of é.  You have several options:

 1) Use the utf8-string package for I/O
 2) Use the text package for I/O (and set an encoding)
 3) GHC 6.12.1 uses the system's locale for encoding; as such if your
 system normally lets you see accented characters then putStrLn,
 etc. will print them out.

 --
 Ivan Lazar Miljenovic
 ivan.miljeno...@gmail.com
 IvanMiljenovic.wordpress.com

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


[Haskell-cafe] Type system game (was: Nomic game in Haskell)

2010-05-07 Thread Dupont Corentin
Hello,
I think your type should be:

type Board a b c d e f g h i =
  Either (Three a b c)
  (Either (Three d e f)
  (Either (Three g h i)
  (Either (Three a d g)
  (Either (Three b e h)
  (Either (Three c f i)
  (Either (Three a e i)
(Three c e g)))

as far as i can understand, it seems thats it's mandatory for Player 1
to play in a,b,c to win?
So victory should go to player 2?

Cheers,
Corentin

On 4/16/10, Dan Piponi dpip...@gmail.com wrote:
 On Thu, Apr 15, 2010 at 4:58 PM, Ashley Yakeley ash...@semantic.org wrote:

 type Board a b c d e f g h i =
  Either (Three a b c)
  (Either (Three d e f)
  (Either (Three g h i)
  (Either (Three a d g)
  (Either (Three b e h)
  (Either (Three c f i)
  (Either (Three a e i)
  (Either (Three c e g)
  )))

 In the service of readability we could also define:

 data X = X
 data O

 Though the victory conditions aren't precisely the usual ones.
 --
 Dan
 ___
 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] accents

2010-05-07 Thread Daniel Fischer
On Friday 07 May 2010 17:05:08, Dupont Corentin wrote:
 Hello,
 i'm still struggling with ghci and accents.

 Prelude é
 \233

That uses the Show instance of Char, which escapes all characters greater 
than '\127' ('\DEL'), so that's no problem, jut inconvenient.


 I've installed GHC 6.12.1, which gave me a better result:

 Prelude putStrLn é
 é

putStrLn doesn't escape printable characters.


 but still:

 Prelude é
 \233

That's interpreted as 

print é

which is

putStrLn (show é)

, hence escaped.


 I'm trying to search a file with french words with Regex, but i
 stumble on accents:

 *Main findRegexFile abnégation
 []
 *Main findRegexFile abn.gation
 [abn\218gation,abn\218gations]


Okay, your file seems to have a weird encoding.

Prelude putStrLn [toEnum 218]
Ú


 I don't know the encoding of my file, how to deduce it?
 What is the encoding used by ghci? Unicode?

I think it uses the system locale and defaults to utf-8 if it can't 
determine the locale.

 Its seems not be the same since the représentation for é is not the
 same (\233 and \218).
 How to have accented characters in ghci? Can't find any ressources on
 the net.

 Cheers,
 Corentin

 PS: please let me know is you can't see the accented characters in
 this email, i'll send you another version with pictures.

 On 3/24/10, Ivan Lazar Miljenovic ivan.miljeno...@gmail.com wrote:
  Dupont Corentin corentin.dup...@gmail.com writes:
  a - readFile list.txt
  head $ lines a
 
  abn\233gation
 
  putStrLn displays a strange character for the é.
 
  That is the escaped form of é.  You have several options:
 
  1) Use the utf8-string package for I/O
  2) Use the text package for I/O (and set an encoding)
  3) GHC 6.12.1 uses the system's locale for encoding; as such if your
  system normally lets you see accented characters then putStrLn,
  etc. will print them out.

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


Re: [Haskell-cafe] darcs to mercurial migration

2010-05-07 Thread Jason Dagit
On Fri, May 7, 2010 at 2:29 AM, Nicolas Pouillard 
nicolas.pouill...@gmail.com wrote:

 On Thu, 06 May 2010 01:08:08 +0200, Günther Schmidt gue.schm...@web.de
 wrote:
  Hello,
 
  I'm switching from darcs to mercurial with some of my projects.
 
  I'd like to retain as much of the history as possible, what tools are
  there available for this?

 I recommend you darcs-fast-export and then use the/a mercurial fast-import.

 http://vmiklos.hu/project/darcs-fast-export/


Does this tool use libdarcs to read the darcs repository data and metadata?
I see the claim that it is correct on the page you linked to:

 Correct

 darcs-fast-export produces correct results in any extreme cases. It has
 been tested with a collection of large darcs repos (called 
 big-zoohttp://code.haskell.org/darcs/big-zoo/).
 And several testcases under the t/ directory.

The correctness argument is solely based on testing of the conversion on
repositories?  If so, how can it remain correct when darcs changes the
format or semantics of its data?

Tailor on the other hand, invokes the various vcs directly and transfers the
diffs between the repositories.  This seems inherently safer to me.

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


[Haskell-cafe] Re: ANNOUNCE: network-protocol-xmpp 0.3

2010-05-07 Thread Sergei Trofimovich
On Mon, 3 May 2010 07:43:25 -0700
John Millikin jmilli...@gmail.com wrote:

 My library, network-protocol-xmpp[2], is an implementation of most of
 RFC 3920 and a bit of RFC 3921. It supports opening client-to-server
 and component-to-server sessions, which is useful for implementing
 XMPP-based clients. This library's interface is very simple: clients
 may start a session with 'runClient' or 'runComponent', send and
 receive stanzas, and resume stored sessions. Later, I intend to add
 additional modules to support features such as MUC or file
 transmission, but for now I'd like to make sure the core library
 works. There's an example XMPP client, echo.hs[3], in the Darcs
 repository.

Hi, John and Stephan!

It's very nice to see such thing on hackage. I'm planning
to write some long hanging notification robots at work using
your library, so I have some questions and comments:

1. gsasl hackage package did not build for me against libgsasl-0.2.28.
It did not define _MAJOR _MINOR macros, So I had to update
up to libgsasl-1.4 which worked fine. Is there way to put constraints
to pkgconfig-depends to .cabal file?

2. Just running echo.hs example causes it to be closed on timeout
from server side (we use OpenFire and idle timeout there is 6 minutes).
So my question is rore about library design abilities: can you inject ping
stanzas (on expired timeout) messages into that example too?

Thanks!

-- 

  Sergei


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


[Haskell-cafe] ANN: test-framework 0.3.0

2010-05-07 Thread Max Bolingbroke
I'm pleased to announce the release of version 0.3 of test-framework
(http://hackage.haskell.org/package/test-framework-0.3.0).

This package provides a nice test runner for HUnit, QuickCheck 1 and
QuickCheck 2 tests. To see a detailed example of the runner in action,
please check out our website at
http://batterseapower.github.com/test-framework

The highlights of this release are:
  * Thanks to the contributions of Rogan Creswick at Galois, you can
now get JUnit XML output from the test runner using the
--jxml=FILENAME option
  * There is a new command line option (--plain), which tells the test
runner to avoid using any ANSI features - this can be handy if you are
(for example) viewing test output in Emacs

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


Re: [Haskell-cafe] {-# LANGUAGE DeriveApplicative #-} ?

2010-05-07 Thread Neil Mitchell
Hi,

If you think you can write an algorithm for deriving Applicative, I'd
welcome you to try adding it to Derive:
http://community.haskell.org/~ndm/derive

The Functor/Foldable/Traversable derivations all started out in
Derive, got tested/implemented/refined there, then moved to GHC later.
I think that's a reasonable path with any Applicative derivation.

Thanks, Neil

On Thu, May 6, 2010 at 11:53 AM, Ben Millwood hask...@benmachine.co.uk wrote:
 On Thu, May 6, 2010 at 8:55 AM, Pavel Perikov peri...@gmail.com wrote:
 Hi, list!.

 Now in 6.12.1 we have DeriveFunctor, DeriveFoldable and DeriveTraversable. 
 This greatly simplifies the reuse structure style of programming. Some 
 structure (not just _data_ structure) got captured in ADT and can be reused 
 for various purposes.

 Wouldn't it be nice to have the ability to derive Applicative as well? It 
 shouldn't be more difficult than deriving Functor but will provide exciting 
 possibilities. Just think about liftA2.


 The difference is that there is at most one law-abiding instance of
 Functor for each type, whereas there are in principle multiple
 possible instances for Applicative for a type. E.g. the following:

 instance Applicative [] where
  pure x = [x]
  fs * xs = concatMap (\f - map f xs) fs

 instance Applicative [] where
  pure = repeat
  (f:fs) * (x:xs) = f x : fs * xs
  _ * _ = []

 are both law-abiding instances (although only one has a corresponding
 law-abiding Monad, I believe). Which should GHC choose?
 It's worth noting, though, that there are other derivable classes that
 don't have a single implementation. It's a question of trading off
 complexity of the compiler versus saved effort in code versus
 additional clarity in code, I think.
 ___
 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] Would it be evil to add deriving Typeable to newtype Q?

2010-05-07 Thread Neil Mitchell
Hi Leonel,

You might want to try Derive
(http://community.haskell.org/~ndm/derive) if DrIFT doesn't work for
you. They do roughly the same jobs, but Derive has more output formats
(it can be spliced in as Template Haskell, generate #include files,
output text etc) more derivations (but not quite overlapping -
although both have Typeable), and is fully cabal-friendly on all
platforms.

Thanks, Neil

On Thu, May 6, 2010 at 3:42 PM, Leonel Fonseca leone...@gmail.com wrote:
 Hey, the hint provided by Ben worked like a charm.

 I've also tried Ivan suggestions both on my windows and linux installations.
 DrIFT-cabalized couldn't install at all at windows since I don't use MinGW.
 So, I ghc'ed --make  DrIFT.

 Both, windows and linux, refused to complete work with this error:
 drift: can't find module Control/Monad

 Thank you.

 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}

 import Data.Typeable
 import Language.Haskell.TH

 deriving instance Typeable1 Q



 --

 Leonel Fonseca.
 ___
 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


[Haskell-cafe] Re: ANNOUNCE: network-protocol-xmpp 0.3

2010-05-07 Thread John Millikin
On Fri, May 7, 2010 at 10:09, Sergei Trofimovich sly...@gmail.com wrote:
 1. gsasl hackage package did not build for me against libgsasl-0.2.28.
    It did not define _MAJOR _MINOR macros, So I had to update
    up to libgsasl-1.4 which worked fine. Is there way to put constraints
    to pkgconfig-depends to .cabal file?

Hm -- I didn't realize anybody was using pre-release GNU SASL
libraries. I've updated the gsasl Cabal file to depend on version 1.1
or higher of the C library (which should be sufficient).

 2. Just running echo.hs example causes it to be closed on timeout
    from server side (we use OpenFire and idle timeout there is 6 minutes).
    So my question is rore about library design abilities: can you inject ping
    stanzas (on expired timeout) messages into that example too?

Added to the example -- it now uses a thread to send ping stanzas
every 60 seconds.

You'll want to install n-p-xmpp 0.3.1 , which adds locking around the
bodies of 'putStanza' and 'getStanza' -- this allows multiple threads
to safely write to the session.

Also: if there's anything else that you'd like to have added to the
library, please feel free to ask! I don't do much fancy stuff with
XMPP, so I don't know which XEP's would be the most useful to
implement.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: ANN: test-framework 0.3.0

2010-05-07 Thread Simon Michael

On 5/7/10 10:49 AM, Max Bolingbroke wrote:

   * There is a new command line option (--plain), which tells the test
runner to avoid using any ANSI features - this can be handy if you are
(for example) viewing test output in Emacs


Thanks! I'll use that in the next release of shelltestrunner.

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


Re: [Haskell-cafe] Would it be evil to add deriving Typeable to newtype Q?

2010-05-07 Thread Ivan Lazar Miljenovic
Neil Mitchell ndmitch...@gmail.com writes:
 You might want to try Derive
 (http://community.haskell.org/~ndm/derive) if DrIFT doesn't work for
 you. They do roughly the same jobs, but Derive has more output formats
 (it can be spliced in as Template Haskell, generate #include files,
 output text etc) more derivations (but not quite overlapping -
 although both have Typeable), and is fully cabal-friendly on all
 platforms.

I take it you haven't had the legal problems that DrIFT had when it used
to be called Derive?  http://www.dcs.gla.ac.uk/~nww/Derive/History.html

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Limestraël
Yes, I wonder why mtl is not updated so as to remove this restriction.


2010/5/1 John Millikin jmilli...@gmail.com

 You might want to make a local version of ErrorT in your library, to
 avoid the silly 'Error' class restriction. This is pretty easy; just
 copy it from the 'transformers' or 'mtl' package.

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


Re: [Haskell-cafe] GHC 6.12 on OS X 10.5

2010-05-07 Thread Jason Dagit
On Mon, Dec 28, 2009 at 9:03 AM, Aaron Tomb at...@galois.com wrote:


 On Dec 22, 2009, at 9:36 PM, wren ng thornton wrote:

  Aaron Tomb wrote:

 I've come across the issue with iconv, as well.
 The problem seems to be that some versions of iconv define iconv_open and
 some related functions as macros (that then call libiconv_open, etc.), and
 some versions of iconv have exported functions for everything. In
 particular, the iconv bundled with OS X (1.11) defines iconv_open, but the
 iconv installed with MacPorts (1.13) does not. The binary package for GHC
 6.12.1 seems to have been compiled on a system without MacPorts, and
 therefore references iconv_open (etc.) from the Apple-distributed version of
 the library.
 If you set up an installation of GHC 6.12 on OS X (I've only tried 10.5)
 with no references to /opt/local/lib, everything works fine. If you include
 /opt/local/lib in the extra-lib-dirs field of your .cabal/config file, it
 tries to link with the MacPorts version and fails with undefined references.


 Is this a problem with *versions* of iconv, or with branches/forks? If
 it's versions, then it seems like migrating to =1.13 would be good for
 everyone. If it's just branches, do you know whether this afflicts Fink
 users as well as MacPorts users, or should I be the guinea pig to test that?


 It's a problem with versions. I checked that the official iconv repository
 does indeed make the change between 1.11 and 1.13 that causes the problem.
 The issue is that OS X includes an old version. So migrating to =1.13 means
 convincing Apple to upgrade what they include with the system. If we can
 accomplish that, I'd be thrilled. But it hasn't happened yet as of 10.6.

 Fink comes with 1.12. I'm not sure whether 1.12 is more like 1.11 or 1.13.


Resurrecting an old thread.

I would like to find out:
  1. Has there been any update on how to workaround this?
  2. Does building 6.12 from macports (or from source on a macports enabled
system) fix the problem?

It seems like more than just GHC is affected by this, but I'm having trouble
digging up solid information on the web about how to workaround it.  Many
sources (such as stackoverflow) point to this thread so posting a solution
here would be a win.

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


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ivan Lazar Miljenovic
Limestraël limestr...@gmail.com writes:
 2010/5/1 John Millikin jmilli...@gmail.com

 You might want to make a local version of ErrorT in your library, to
 avoid the silly 'Error' class restriction. This is pretty easy; just
 copy it from the 'transformers' or 'mtl' package.

 Yes, I wonder why mtl is not updated so as to remove this restriction.

Presumably because its in maintenance mode (i.e. it only gets
changed/updated to reflect changes in GHC that might affect it and the
API is frozen).

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Shorthand method of enumerating a list a gotcha ... or is it just me?

2010-05-07 Thread Gene A
The problem I see is that in both:
 Version: September 2006 of hugs, which is the one that is current for
Ubuntu 9.10 release, and
ghci 6.10.4, they both exhibit a {I think} strange behaviour, in regards
to the shorthand way of calling out a list of enumerable values.  I will
explain the problem that I have run into with examples:

Hugs [3,7..22]
[3,7,11,15,19] - OK

Hugs map (* 1.0) [3,7,11,15,19]  - manual spec OK
[3.0,7.0,11.0,15.0,19.0]

Hugs map (* 1.0) [3,7..22]   - same spec as first but !!! when
mapped to with a (*1.0) to
coerce
them to reals:
[3.0,7.0,11.0,15.0,19.0,23.0]   - went one outside of range spec.


Exactly the same behaviour from ghci 6.10.4 :

Prelude [3,7..22]
[3,7,11,15,19]

Prelude map (* 1.0) [3,7..22]  - using a range
[3.0,7.0,11.0,15.0,19.0,23.0] - it screws up
 {at least it is not a
feature' to me}

Prelude map (* 1.0) [3,7,11,15,19]   - spelled out it acts right.
[3.0,7.0,11.0,15.0,19.0]

This seems like a possible bug? or at least a sure fire trap waiting to
be sprung ... one of those nasties that could really create havoc if
someone is not aware of this behaviour and buries a function that include
something that unwittingly coerces from an Integral to a Realfrac or
Fractional.  Is this a well known thing to watch out for..
or is it something that can be worked around, other then having to
enumerate every value in a list rather then use the handiness of
the range notation as shorthand?

cheers,

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


Re: [Haskell-cafe] Shorthand method of enumerating a list a gotcha ... or is it just me?

2010-05-07 Thread Ivan Lazar Miljenovic
Gene A yumag...@gmail.com writes:

 The problem I see is that in both:
  Version: September 2006 of hugs, which is the one that is current for
 Ubuntu 9.10 release, and
 ghci 6.10.4, they both exhibit a {I think} strange behaviour, in regards
 to the shorthand way of calling out a list of enumerable values.  I will
 explain the problem that I have run into with examples:

 Hugs [3,7..22]
 [3,7,11,15,19] - OK

 Hugs map (* 1.0) [3,7,11,15,19]  - manual spec OK
 [3.0,7.0,11.0,15.0,19.0]

 Hugs map (* 1.0) [3,7..22]   - same spec as first but !!! when
 mapped to with a (*1.0) to
 coerce
 them to reals:
 [3.0,7.0,11.0,15.0,19.0,23.0]   - went one outside of range spec.

 [snip]

 This seems like a possible bug? or at least a sure fire trap waiting to
 be sprung ... one of those nasties that could really create havoc if
 someone is not aware of this behaviour and buries a function that include
 something that unwittingly coerces from an Integral to a Realfrac or
 Fractional.  Is this a well known thing to watch out for..
 or is it something that can be worked around, other then having to
 enumerate every value in a list rather then use the handiness of
 the range notation as shorthand?

This is because the Enum instance for floating point numbers is screwy
and shouldn't be used in general (floating point rounding, etc.; don't
forget, they're defined in binary and not all fractional values can be
defined exactly in a finite binary value).  A better way:

map fromIntegral [3,7..22]

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Shorthand method of enumerating a list a gotcha ... or is it just me?

2010-05-07 Thread Roel van Dijk
From the Haskell 98 report (section 6.3.4):

 For Float and Double, the semantics of the enumFrom  family is given by the 
 rules for Int above, except that the list terminates when the elements become 
 greater than e3+i/2  for positive increment i, or  when they become less 
 than e3+i/2  for negative i.

So yes, it is surprising, but according to the specification. But then
again the very concept of a type like Float having an Enum instance is
a bit weird.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Would it be evil to add deriving Typeable to newtype Q?

2010-05-07 Thread Mike Dillon
begin Ivan Lazar Miljenovic quotation:
 Neil Mitchell ndmitch...@gmail.com writes:
  You might want to try Derive
  (http://community.haskell.org/~ndm/derive) if DrIFT doesn't work for
  you. They do roughly the same jobs, but Derive has more output formats
  (it can be spliced in as Template Haskell, generate #include files,
  output text etc) more derivations (but not quite overlapping -
  although both have Typeable), and is fully cabal-friendly on all
  platforms.
 
 I take it you haven't had the legal problems that DrIFT had when it used
 to be called Derive?  http://www.dcs.gla.ac.uk/~nww/Derive/History.html

Looks like derive.com is redirecting to a Texas Instruments site under
ti.com, so they likely don't care about this particular trademark
anymore since it is no longer maintained as an independent brand. Looks
like they stopped selling it in June 2007, at least in the UK:


http://education.ti.com/educationportal/sites/UK/productDetail/uk_derive6.html

The other link I found redirected to a page that didn't mention Derive™
at all.

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 4, 2010, at 01:52 , Maciej Piechotka wrote:

After change of file you have to wait a long time as it compiles and
links with yi. On my system (1 GB of RAM taken by system + 1 GB  
'free' +

2 GB swaps, x86-64) it could in some situations it caused OOM. I'd
prefer if the code was interpreted by ghci instead of compiled by  
GHC in

this case (it should be as fast as most of the code was compiled
anyway).



On the one hand, this is doable with the GHC API.  On the other, that  
more or less means your program contains what amounts to a full copy  
of GHC.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ross Paterson
On Sat, May 08, 2010 at 07:49:57AM +1000, Ivan Lazar Miljenovic wrote:
 Limestraël limestr...@gmail.com writes:
  2010/5/1 John Millikin jmilli...@gmail.com
 
  You might want to make a local version of ErrorT in your library, to
  avoid the silly 'Error' class restriction. This is pretty easy; just
  copy it from the 'transformers' or 'mtl' package.
 
  Yes, I wonder why mtl is not updated so as to remove this restriction.
 
 Presumably because its in maintenance mode (i.e. it only gets
 changed/updated to reflect changes in GHC that might affect it and the
 API is frozen).

The API isn't frozen -- it can be changed with a library proposal,
if you can get people to agree to it.

As Ryan said, the Error constraint is there to support a definition of
the fail method in the Monad instance for ErrorT.  (Personally I think
fail is a terrible wart, and should be shunned.)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 5, 2010, at 21:49 , Pierre-Etienne Meunier wrote:

- all these =, significative indentation, You're from the past dude.



Careful, or Guido (van Rossum) is going to show up on your doorstep

--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 6, 2010, at 11:08 , Donn Cave wrote:

different ambitions.  Who would pick Tcl for a programming language?
but it has been popular for scripting (still?  don't know.)  It would


I think Lua has superseded it, because it has the compactness  
advantage and easy embeddability of of the Tcl core but is enormously  
easier to write code in.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Limestraël
There is the package hint, which embeds the calls to GHC API.

Quite easy to use:
Let's say your configuration file (cfg/Script.hs) contains a function
script that you want to get:

type ScriptFun = IO ()

loadScript :: IO ScriptFun
loadScript = do
  liftM (either (error . show) id) $ runInterpreter $ do
path - get searchPath
set [searchPath := (./cfg:path)]
loadModules [Script]
setTopLevelModules [Script]
exports - getModuleExports Script
if Fun script `elem` exports
  then *interpret script (as :: ScriptFun)*
  else error script function not found


There is just the line I put in bold that bothers me. Can't we get the
action script more easily than by re-interpreting some code?

2010/5/8 Brandon S. Allbery KF8NH allb...@ece.cmu.edu

 On May 4, 2010, at 01:52 , Maciej Piechotka wrote:

 After change of file you have to wait a long time as it compiles and
 links with yi. On my system (1 GB of RAM taken by system + 1 GB 'free' +
 2 GB swaps, x86-64) it could in some situations it caused OOM. I'd
 prefer if the code was interpreted by ghci instead of compiled by GHC in
 this case (it should be as fast as most of the code was compiled
 anyway).



 On the one hand, this is doable with the GHC API.  On the other, that more
 or less means your program contains what amounts to a full copy of GHC.

 --
 brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
 system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
 electrical and computer engineering, carnegie mellon universityKF8NH



 ___
 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] IO (Either a Error) question

2010-05-07 Thread Limestraël
 Personally I think fail is a terrible wart, and should be shunned.

So do I.
I can't understand its purpose since monads which can fail can be
implemented through MonadPlus.


2010/5/8 Ross Paterson r...@soi.city.ac.uk

 On Sat, May 08, 2010 at 07:49:57AM +1000, Ivan Lazar Miljenovic wrote:
  Limestraėl limestr...@gmail.com writes:
   2010/5/1 John Millikin jmilli...@gmail.com
  
   You might want to make a local version of ErrorT in your library, to
   avoid the silly 'Error' class restriction. This is pretty easy; just
   copy it from the 'transformers' or 'mtl' package.
  
   Yes, I wonder why mtl is not updated so as to remove this restriction.
 
  Presumably because its in maintenance mode (i.e. it only gets
  changed/updated to reflect changes in GHC that might affect it and the
  API is frozen).

 The API isn't frozen -- it can be changed with a library proposal,
 if you can get people to agree to it.

 As Ryan said, the Error constraint is there to support a definition of
 the fail method in the Monad instance for ErrorT.  (Personally I think
 fail is a terrible wart, and should be shunned.)
 ___
 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] IO (Either a Error) question

2010-05-07 Thread Gregory Crosswhite

On May 7, 2010, at 4:54 PM, Limestraël wrote:

  Personally I think fail is a terrible wart, and should be shunned.
 
 So do I.
 I can't understand its purpose since monads which can fail can be implemented 
 through MonadPlus.

As far as I can tell, its purpose is to essentially allow you to catch pattern 
match errors in pure code and turn them into a value, since Haskell calls fail 
whenever there is a failed pattern match.  (I am not saying that this is a good 
idea, only that this is not something that you would simply get by using 
MonadPlus.)

Cheers,
Greg

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 7, 2010, at 19:51 , Limestraël wrote:

  then interpret script (as :: ScriptFun)

There is just the line I put in bold that bothers me. Can't we get  
the action script more easily than by re-interpreting some code?



Make up your mind:  you don't want to have to compile the script, but  
you don't want to have to interpret the script.  What exactly is  
supposed to be left?


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ross Paterson
On Sat, May 08, 2010 at 01:54:21AM +0200, Limestraël wrote:
  Personally I think fail is a terrible wart, and should be shunned.
 
 So do I.
 I can't understand its purpose since monads which can fail can be implemented
 through MonadPlus.

It was introduced to implement pattern match failure in do-notation,
in Section 3.14 of the Haskell Report:

  do {p - e; stmts} = let ok p = do {stmts}
   ok _ = fail ...
   in e = ok
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 7, 2010, at 19:54 , Limestraël wrote:

 Personally I think fail is a terrible wart, and should be shunned.

So do I.
I can't understand its purpose since monads which can fail can be  
implemented through MonadPlus.



The translation of do syntax involves pattern matching (do  
{ [x,y,z] - something; ... }), and needs to know what to do when the  
pattern bind fails, so what it does is invoke fail.  This is  
arguably wrong but we're stuck with it now.  (I have to admit I don't  
see why we can't do exactly what the obvious (= \[x,y,z] - ...)  
translation does, which is throw an exception.  case, let, and  
lambda binding don't invoke a special fail mechanism; why is do  
special?)


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Dan Doel
On Friday 07 May 2010 7:54:21 pm Limestraël wrote:
  Personally I think fail is a terrible wart, and should be shunned.
 
 So do I.
 I can't understand its purpose since monads which can fail can be
 implemented through MonadPlus.

Understanding why fail exists requires going back to before Haskell 98. Back 
then, there was a MonadZero, and when you did pattern matching in do syntax, a 
MonadZero constraint would be generated in most cases, like:

  do Just x - m
 ...

*But*, there were cases where MonadZero wasn't required. This happened when 
you did a match like:

  do (x, y) - m
 ...

In this case, there's no need to fail 'in the monad', because either the value 
in question *is* of the form (x, y), or it is bottom, in which case the whole 
expression should be bottom anyhow (because we're not supposed to be able to 
detect bottoms like that). Patterns like the above had a special distinction, 
called unfailable. This is not the same as irrefutable, although the latter 
would be a special case of the former; unfailable patterns are those that can 
at most be refuted by a partially defined value, rather than refuted by a sum.

So, for reasons that I don't recall off the top of my head (perhaps pedagogy), 
it was decided that Haskell 98 should no longer have this additional notion of 
unfailable pattern. However, when you get rid of them, there's a fair amount 
of valid code with a context of Monad m that now needs MonadZero (or, Plus, 
since Zero is gone), and that's rather inconvenient. So, fail was introduced 
into Monad so that pattern matching can be desugared in any Monad, and you're 
once again allowed to write:

  foo :: Monad m = m (a,b) - ...
  foo m = do (x, y) - m
 ...

Which is always okay, even though other matches/etc. you can do with fail 
really isn't.

Personally, I don't really understand why unfailable patterns were canned 
(they don't seem that complicated to me), so I'd vote to bring them back, and 
get rid of fail. But hind sight is 20/20, I suppose (or perhaps there exist 
cogent arguments that I haven't heard).

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Pierre-Etienne Meunier
Shit ! I'll have to explain him how to add monads in python 3 ;-)


El 07/05/2010, a las 19:31, Brandon S. Allbery KF8NH escribió:

 On May 5, 2010, at 21:49 , Pierre-Etienne Meunier wrote:
 - all these =, significative indentation, You're from the past dude.
 
 
 Careful, or Guido (van Rossum) is going to show up on your doorstep
 
 -- 
 brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
 system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
 electrical and computer engineering, carnegie mellon universityKF8NH
 
 

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Pierre-Etienne Meunier
By the way, I do not know the GHC API well enough to say if it is possible to 
embed a super small bytecode interpreter, but :

- If it is the case, then users who do not want to write scripts can use it. 
Others would want to compile haskell code, therefore they need GHC anyway.
- If it is not, then a cool thing to do for the GHC team would be to add one ;-)

In both cases, if someone on haskell-cafe knows the answer, could he write it 
on the wiki in the page about the ghc api ?

Cheers,
PE

El 07/05/2010, a las 19:22, Brandon S. Allbery KF8NH escribió:

 On May 4, 2010, at 01:52 , Maciej Piechotka wrote:
 After change of file you have to wait a long time as it compiles and
 links with yi. On my system (1 GB of RAM taken by system + 1 GB 'free' +
 2 GB swaps, x86-64) it could in some situations it caused OOM. I'd
 prefer if the code was interpreted by ghci instead of compiled by GHC in
 this case (it should be as fast as most of the code was compiled
 anyway).
 
 
 On the one hand, this is doable with the GHC API.  On the other, that more or 
 less means your program contains what amounts to a full copy of GHC.
 
 -- 
 brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
 system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
 electrical and computer engineering, carnegie mellon universityKF8NH
 
 
 ___
 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] Re: Haskell and scripting

2010-05-07 Thread Pierre-Etienne Meunier
There is a also a problem with polymorphic actions of functions. The GHC API is 
typesafe only when returning elements of the Typeable class. Else you can do an 
unsafeCoerce, but I assume that hint uses Typeable, with a wrapper class to 
ensure monomorphism.

But if your script action returns a monomorphic type, you can use the GHC API 
directly instead and unsafeCoerce.


El 07/05/2010, a las 20:12, Brandon S. Allbery KF8NH escribió:

 On May 7, 2010, at 19:51 , Limestraël wrote:
   then interpret script (as :: ScriptFun)
 
 There is just the line I put in bold that bothers me. Can't we get the 
 action script more easily than by re-interpreting some code?
 
 
 Make up your mind:  you don't want to have to compile the script, but you 
 don't want to have to interpret the script.  What exactly is supposed to be 
 left?
 
 -- 
 brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
 system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
 electrical and computer engineering, carnegie mellon universityKF8NH
 
 
 ___
 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


[Haskell-cafe] Haskell interface to Frama-C

2010-05-07 Thread Tom Hawkins
I just started using Frama-C [1] for analyzing some of our embedded C
programs.  Pretty awesome suite of tools.  Especially its ability to
describe and verify function contracts with ACSL [2].  The tool suite
is primarily build with OCaml.

Has anyone considered building a Haskell interface to Frama-C?  I lack
the expertise and time for such a project.  But it sure would be nice
to be able to write verification plug-ins with Haskell.

-Tom

[1] http://frama-c.com/
[2] http://en.wikipedia.org/wiki/ANSI/ISO_C_Specification_Language
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell and the Software design process

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 3, 2010, at 12:14 , Henning Thielemann wrote:

Ketil Malde schrieb:

Henning Thielemann lemm...@henning-thielemann.de writes:

http://www.haskell.org/ghc/docs/6.12.2/html/libraries/base-4.2.0.1/Control-Exception.html#v%3Athrow



I see. This should be forbidden, at all! :-)


Why is this worse than or different from 'error'?  To me it looks  
like

'error', only with a non-string parameter.


Because it encourages the use in a non-error way, that is, catching  
such

an exception is regarded as good use.


One could argue that it's a more comprehensible to mortals version of  
Control.Monad.Cont.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Andy Stewart
Daniel Fischer daniel.is.fisc...@web.de writes:

 On Wednesday 05 May 2010 23:36:26, Limestraël wrote:
 but you will not object if I say that scheme is quicker to learn
 than Haskell.

 Well, I do object. Learning Haskell went like a breeze (not to perfection, 
 but well enough). Only Python was nearly as easy and quick to learn.
 Learning Lisp dialects is much harder (to a large part because of the 
 parentheses, which makes them near impossible to parse).
Perhaps you need perfect lisp editor (emacs) to help you parse those
parentheses. :)

Looks below extension to highlight parentheses if you're emacser.
It help you parse parentheses when you through *parentheses forest*.

http://www.emacswiki.org/emacs/HighlightParentheses

  -- Andy


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


Re: [Haskell-cafe] Haskell and the Software design process

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 4, 2010, at 12:31 , Gregory Crosswhite wrote:

On May 4, 2010, at 5:22 AM, John Lato wrote:

Crashing at the point of the error isn't necessarily useful in
Haskell due to lazy evaluation.  The code will crash when the result
of the partial function is evaluated, which may be quite far away (in
terms of function calls) from where the programmer would expect.


But hypothetically, suppose that you decided to use  
safeSecondElement anyway;  now you have to deal with a Nothing in  
your code.  Since, again, you don't know how to recover from this  
(as if you did, you wouldn't have gotten a Nothing in the first  
place), the only thing you can do is propagate it through the  
calculation, until it reaches someone who can recover from it, which  
means that now your whole calculation has to be muddled up with  
Maybe types wrapping every result purely to capture the


Using Maybe as a monad helps a lot here.

possibility of a bug (or hardware fault, I suppose).  If your  
program relied on this calculation, then it *still* has no choice  
but to terminate, and it *still* doesn't know where the error occurred


It occurs to me that combining Error and Writer gives you traceback.

--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANN: test-framework 0.3.0

2010-05-07 Thread Gregory Collins
Max Bolingbroke batterseapo...@hotmail.com writes:

 I'm pleased to announce the release of version 0.3 of test-framework
 (http://hackage.haskell.org/package/test-framework-0.3.0).
 ...
   * There is a new command line option (--plain), which tells the test
 runner to avoid using any ANSI features - this can be handy if you are
 (for example) viewing test output in Emacs

I don't see this one, although the junit option is there:

./dist/build/testsuite/testsuite --plain
unrecognized option `--plain'
Usage: testsuite [OPTIONS]
   --help   show this 
help message
  -j NUMBER--threads=NUMBER number of 
threads to use to run tests
   --test-seed=NUMBER|randomdefault 
seed for test random number generator
  -a NUMBER--maximum-generated-tests=NUMBER how many 
automated tests something like QuickCheck should try, by default
   --maximum-unsuitable-generated-tests=NUMBER  how many 
unsuitable candidate tests something like QuickCheck should endure before 
giving up, by default
  -o NUMBER--timeout=NUMBER how many 
seconds a test should be run for before giving up, by default
   --no-timeout specifies 
that tests should be run without a timeout, by default
  -t TEST-PATTERN  --select-tests=TEST-PATTERN  only tests 
that match at least one glob pattern given by an instance of this argument will 
be run
   --jxml[=FILE]Set the 
output format to junit-xml, and (optionally) writes to FILE instead of STDOUT

G
-- 
Gregory Collins g...@gregorycollins.net
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] darcs to mercurial migration

2010-05-07 Thread Marc Weber
Hi Günther,

tehre is a fast darcs to git tool.
Maybe you can convert to mercurial easily then.

Ping me on irc (MarcWeber) or write back if you're interested.
I'll digg the link up then.

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Limestraël
You might have misunderstood me.

When using hint, one wants the script to be interpreted.
It is interpreted when called  loadModules [Script] , but if we call
later  interpret *something* (as :: Something) , the *something *can be
any Haskell code, not just a function name, which means hint has also to
interpret the *something*.
So, IMO, a double interpretation is done when a function such as getSymbol
*functionName *(as :: FuncType), which would simply get the function, would
be sufficient.
I don't know if hint/GHC API allows to do such a thing...


2010/5/8 Brandon S. Allbery KF8NH allb...@ece.cmu.edu

 On May 7, 2010, at 19:51 , Limestraël wrote:

   then *interpret script (as :: ScriptFun)*

 There is just the line I put in bold that bothers me. Can't we get the
 action script more easily than by re-interpreting some code?


 Make up your mind:  you don't want to have to compile the script, but you
 don't want to have to interpret the script.  What exactly is supposed to be
 left?

 --
 brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
 system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
 electrical and computer engineering, carnegie mellon universityKF8NH



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


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread John Meacham
On Fri, May 07, 2010 at 08:27:04PM -0400, Dan Doel wrote:
 Personally, I don't really understand why unfailable patterns were canned
 (they don't seem that complicated to me), so I'd vote to bring them back, and
 get rid of fail. But hind sight is 20/20, I suppose (or perhaps there exist
 cogent arguments that I haven't heard).

What counts as unfailable?

(x,y) probably,  but what about

data Foo = Foo x y

If we don't allow it, we add 'magic' to tuples, which is a bad thing, if
we do allow it, there are some odd consequences.

adding another constructor to Foo will suddenly change the type of do
notations involving it non locally. said constructor may not even be
exported from the module defining Foo, its existence being an
implementation detail.

All in all, it is very hacky one way or another. Much more so than
having 'fail' in Monad.

John

-- 
John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread David Menendez
On Fri, May 7, 2010 at 10:26 PM, John Meacham j...@repetae.net wrote:
 On Fri, May 07, 2010 at 08:27:04PM -0400, Dan Doel wrote:
 Personally, I don't really understand why unfailable patterns were canned
 (they don't seem that complicated to me), so I'd vote to bring them back, and
 get rid of fail. But hind sight is 20/20, I suppose (or perhaps there exist
 cogent arguments that I haven't heard).

 What counts as unfailable?

 (x,y) probably,  but what about

 data Foo = Foo x y

 If we don't allow it, we add 'magic' to tuples, which is a bad thing, if
 we do allow it, there are some odd consequences.

 adding another constructor to Foo will suddenly change the type of do
 notations involving it non locally. said constructor may not even be
 exported from the module defining Foo, its existence being an
 implementation detail.

 All in all, it is very hacky one way or another. Much more so than
 having 'fail' in Monad.

I wonder how often people rely on the use of fail in pattern matching.
Could we get by without fail or unfailable patterns?

ensureCons :: MonadPlus m = [a] - m [a]
ensureCons x@(_:_) = return x
ensureCons _ = mzero

do ...
x:xs - ensureCons $ some_compuation

This is more flexible than the current situation (you can easily adapt
it to throw custom exceptions in ErrorT), but gets cumbersome when
you're doing nested patterns. Also, it does the match twice, but
presumably the optimizer can be improved to catch that if the idiom
became popular.

-- 
Dave Menendez d...@zednenem.com
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] installing haskell platform on 64-bit ubuntu 10.04 (Lucid)

2010-05-07 Thread Andy Lee
Has anyone had problems getting Haskell Platform installed on Ubuntu 
10.04?


I've got GHC 6.12.1 installed via apt-get, and I've 
downloaded/untarred haskell-platform-2010.1.0.0.tar.gz.  But when I 
run ./configure, it fails fairly quickly, with an error 'cause it 
can't build the hello world test program, complaining:


command line: unknown package: haskell98


Anyone else seen this? Am I missing something obvious?



--Andy

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


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 7, 2010, at 22:18 , Limestraël wrote:

When using hint, one wants the script to be interpreted.
It is interpreted when called  loadModules [Script] , but if we  
call later  interpret something (as :: Something) , the something  
can be any Haskell code, not just a function name, which means hint  
has also to interpret the something.


Not entirely clear to me, actually:  the earlier one might generate  
bytecode and the later one run it.  (I haven't looked at hint, but  
have some idea of what GHC-API can do.)


So, IMO, a double interpretation is done when a function such as  
getSymbol functionName (as :: FuncType), which would simply get  
the function, would be sufficient.

I don't know if hint/GHC API allows to do such a thing...


GHC API should let you look up names directly; as above, I don't know  
if hint does.  hs-plugins used to do this also but it is obsolete (was  
far too dependent on GHC internal data and had to be rewritten for  
every GHC release; the GHC API is more stable).


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ivan Lazar Miljenovic
Limestraël limestr...@gmail.com writes:

 Personally I think fail is a terrible wart, and should be shunned.

 So do I.
 I can't understand its purpose since monads which can fail can be
 implemented through MonadPlus.

Polyparse uses it, and I believe Parsec does as well...

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ivan Lazar Miljenovic
David Menendez d...@zednenem.com writes:

 I wonder how often people rely on the use of fail in pattern matching.
 Could we get by without fail or unfailable patterns?

 ensureCons :: MonadPlus m = [a] - m [a]
 ensureCons x@(_:_) = return x
 ensureCons _ = mzero

 do ...
 x:xs - ensureCons $ some_compuation

 This is more flexible than the current situation (you can easily adapt
 it to throw custom exceptions in ErrorT), but gets cumbersome when
 you're doing nested patterns. Also, it does the match twice, but
 presumably the optimizer can be improved to catch that if the idiom
 became popular.

Well, any time you have a do-block like this you're using failable
patterns:

maybeAdd   :: Maybe Int - Maybe Int - Maybe Int
maybeAdd mx my = do x - mx
y - my
return $ x + y


-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread David Menendez
On Sat, May 8, 2010 at 12:15 AM, Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com wrote:
 David Menendez d...@zednenem.com writes:

 I wonder how often people rely on the use of fail in pattern matching.
 Could we get by without fail or unfailable patterns?

 ensureCons :: MonadPlus m = [a] - m [a]
 ensureCons x@(_:_) = return x
 ensureCons _ = mzero

 do ...
     x:xs - ensureCons $ some_compuation

 This is more flexible than the current situation (you can easily adapt
 it to throw custom exceptions in ErrorT), but gets cumbersome when
 you're doing nested patterns. Also, it does the match twice, but
 presumably the optimizer can be improved to catch that if the idiom
 became popular.

 Well, any time you have a do-block like this you're using failable
 patterns:

 maybeAdd       :: Maybe Int - Maybe Int - Maybe Int
 maybeAdd mx my = do x - mx
                    y - my
                    return $ x + y

This is true in the sense that the translation for the do syntax in
the Haskell report uses fail.

do { p - e; stmts } =
let ok p = do { stmts }
ok _ = fail ...
in e = ok

However, it's also true that the fails introduced by the translation
of maybeAdd will never be invoked, since the two patterns are
irrefutable. That is, maybeAdd would work exactly the same if the do
syntax translation were changed to read:

do { p - e; stmts } = e = \p - do { stmts }


This would not be the case if refutable patterns were used.

viewM l = do { x:xs - return l; return (x,xs) }

-- 
Dave Menendez d...@zednenem.com
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ivan Lazar Miljenovic
David Menendez d...@zednenem.com writes:

 On Sat, May 8, 2010 at 12:15 AM, Ivan Lazar Miljenovic
 Well, any time you have a do-block like this you're using failable
 patterns:

 maybeAdd   :: Maybe Int - Maybe Int - Maybe Int
 maybeAdd mx my = do x - mx
y - my
return $ x + y

 This is true in the sense that the translation for the do syntax in
 the Haskell report uses fail.

 do { p - e; stmts } =
 let ok p = do { stmts }
 ok _ = fail ...
 in e = ok

 However, it's also true that the fails introduced by the translation
 of maybeAdd will never be invoked, since the two patterns are
 irrefutable.

Huh?  What about maybeAdd (Just 2) Nothing ?

 That is, maybeAdd would work exactly the same if the do syntax
 translation were changed to read:

 do { p - e; stmts } = e = \p - do { stmts }

Wait, are you using irrefutable as it will still work if we make do
blocks work the way I want?

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Brandon S. Allbery KF8NH

On May 8, 2010, at 01:16 , Ivan Lazar Miljenovic wrote:

David Menendez d...@zednenem.com writes:

On Sat, May 8, 2010 at 12:15 AM, Ivan Lazar Miljenovic

Well, any time you have a do-block like this you're using failable
patterns:

maybeAdd   :: Maybe Int - Maybe Int - Maybe Int
maybeAdd mx my = do x - mx
  y - my
  return $ x + y


This is true in the sense that the translation for the do syntax in
the Haskell report uses fail.


Huh?  What about maybeAdd (Just 2) Nothing ?


Isn't that handled by the definition of (=) in Maybe, as opposed to  
by invoking fail?


 instance Monad Maybe where
   -- ...
   Nothing = _ = Nothing
   (Just x) = f = f x

--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allb...@kf8nh.com
system administrator [openafs,heimdal,too many hats] allb...@ece.cmu.edu
electrical and computer engineering, carnegie mellon universityKF8NH




PGP.sig
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: IO (Either a Error) question

2010-05-07 Thread Maciej Piechotka
On Fri, 2010-05-07 at 19:26 -0700, John Meacham wrote:
 On Fri, May 07, 2010 at 08:27:04PM -0400, Dan Doel wrote:
  Personally, I don't really understand why unfailable patterns were canned
  (they don't seem that complicated to me), so I'd vote to bring them back, 
  and
  get rid of fail. But hind sight is 20/20, I suppose (or perhaps there exist
  cogent arguments that I haven't heard).
 
 What counts as unfailable?
 
 (x,y) probably,  but what about
 
 data Foo = Foo x y
 
 If we don't allow it, we add 'magic' to tuples, which is a bad thing, if
 we do allow it, there are some odd consequences.
 
 adding another constructor to Foo will suddenly change the type of do
 notations involving it non locally. said constructor may not even be
 exported from the module defining Foo, its existence being an
 implementation detail.
 
 All in all, it is very hacky one way or another. Much more so than
 having 'fail' in Monad.
 
 John
 

Sorry I'm asking but why:

do Constructor x y z - f
   g x y z

is not compiled into:

f = \(Constructor x y z) - g x y z

Hence using exactly the same way or reporting errors as pure functions?
I.e. why fail !== error[1]

Regards

[1] Well - what came to my mind is something like:

func :: Either a b - Maybe b
func f = do Right x - f
return x

But:
1. It's IMHO vary bad style as it silently fails in cases mentioned
above.
2. It is not obvious knowing rest of Haskell. I expected until now a
pattern failure error.


signature.asc
Description: This is a digitally signed message part
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO (Either a Error) question

2010-05-07 Thread Ivan Lazar Miljenovic
Brandon S. Allbery KF8NH allb...@ece.cmu.edu writes:

 On May 8, 2010, at 01:16 , Ivan Lazar Miljenovic wrote:
 Huh?  What about maybeAdd (Just 2) Nothing ?

 Isn't that handled by the definition of (=) in Maybe, as opposed to
 by invoking fail?

 instance Monad Maybe where
   -- ...
   Nothing = _ = Nothing
   (Just x) = f = f x

Yes, but isn't the y - Nothing pattern failure handled by invoking
fail?

-- 
Ivan Lazar Miljenovic
ivan.miljeno...@gmail.com
IvanMiljenovic.wordpress.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Haskell and scripting

2010-05-07 Thread Evan Laforge
 On the one hand, this is doable with the GHC API.  On the other, that more
 or less means your program contains what amounts to a full copy of GHC.

And the result is that your binary will grow by 35mb, add a few
seconds to launch time, the first expression will take 3 or 4 seconds
to evaluate, and add around 10 seconds to the link time.  After that
it's pretty reasonable though.

I've actually thought of embedding a version of hugs, that should be
smaller and faster, but as soon as you want to use significant amounts
of libraries it gets to be a hassle to keep the source around and it
may not even be hugs compatible anyway.  GHC's big advantage is it can
load the same binary libraries the rest of the program uses.  I don't
know if hugs was really designed to be embedded anyway.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe