[Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Sönke Hahn
Hi all!

string-conversions is a very simple package to facilitate dealing with 
different string types. It provides a simple type class that allows you to 
convert between values of different string types. It also provides type 
synonyms for these string types.

Supported types are:

- String
- Strict ByteString
- Lazy ByteString
- Strict Text
- Lazy Text

http://hackage.haskell.org/package/string-conversions

Any comments welcome.

Cheers,
Sönke



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


Re: [Haskell-cafe] If you'd design a Haskell-like language, what would you do different?

2012-03-09 Thread Jerzy Karczmarczuk
 John Meacham :
 The fact that bottom is a value in Haskell is the fundamental thing that
 differentiates Haskell from other languages and the source of its power. The
 fact that f _|_ /= _|_ potentially _is_ what it means to be a lazy language.
 Not treating
 _|_ as a value would be a huge disservice to anyone learning the language.
 Sure, it may seem a little strange coming from the imperative world to think
 of it as a value, but it is by far the oddest concept in Haskell, after all,
 _functions_ are values in Haskell and people seem to eventually figure that
 out.
Well...
Personally I hate thinking about bottom as value. I don't do this. I
NEVER teach that. And, I am a lazy guy, almost all my Haskell programs
are strongly based on laziness.

I'll tell you what I teach, and you might throw some tomatoes...
The fundamental thing that differentiates Haskell from other languages
and the source of it power - if I might cite you - is that we don't see
the difference between an object and the process which creates it.  (The
difference demands that we speak about the call-by-need, etc...)
The bottom, as sin (2*pi), or Text may be seen as processes. Anyway, a
lazy list IS a process /par excellence/. The _|_ entity is a process
which refuses to give you a value (or does it in a deadly way). Your
program manipulates processes. A process in some computational context
must do something - or not. The bottom never does anything useful.

All this is probably a question of language, of terminology, of
preconceptions (of all that, what for God knows which reasons, Americans
call just semantics), but I will not forget the day when I thought as
you, and I had to explain to 2-nd year students what does it mean: a
value which doesn't have a value...

Thank you.

Jerzy Karczmarczuk




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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Joachim Breitner
Hi Sönke,

Am Freitag, den 09.03.2012, 11:17 +0100 schrieb Sönke Hahn:
 Any comments welcome.

you could elaborate the documenatation “Assumes UTF-8” – I guess this
only applies to the two ByteString variants, as String and Text _should_
contain unicode codepoints and no encoding. Not that someone tries to
use a String where each Char corresponds to a byte in a UTF-8 encoded
string and thinks he can convert it correctly.

I was about to suggest to merge this into the convertible package (to
fight package proliferation), but found that it seems it is already
there:
http://hackage.haskell.org/packages/archive/convertible-text/0.4.0.2/doc/html/src/Data-Convertible-Instances-Text.html

Greetings,
Joachim

-- 
Joachim nomeata Breitner
  m...@joachim-breitner.de  |  nome...@debian.org  |  GPG: 0x4743206C
  xmpp: nome...@joachim-breitner.de | http://www.joachim-breitner.de/



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] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Michael Snoyman
On Fri, Mar 9, 2012 at 1:40 PM, Joachim Breitner
m...@joachim-breitner.de wrote:
 Hi Sönke,

 Am Freitag, den 09.03.2012, 11:17 +0100 schrieb Sönke Hahn:
 Any comments welcome.

 you could elaborate the documenatation “Assumes UTF-8” – I guess this
 only applies to the two ByteString variants, as String and Text _should_
 contain unicode codepoints and no encoding. Not that someone tries to
 use a String where each Char corresponds to a byte in a UTF-8 encoded
 string and thinks he can convert it correctly.

 I was about to suggest to merge this into the convertible package (to
 fight package proliferation), but found that it seems it is already
 there:
 http://hackage.haskell.org/packages/archive/convertible-text/0.4.0.2/doc/html/src/Data-Convertible-Instances-Text.html

 Greetings,
 Joachim

 --
 Joachim nomeata Breitner
  m...@joachim-breitner.de  |  nome...@debian.org  |  GPG: 0x4743206C
  xmpp: nome...@joachim-breitner.de | http://www.joachim-breitner.de/


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


I'm the author of convertible-text, and I consider it deprecated (it's
marked as such in the synopsis).

As far as string-conversions, I'm a little concerned that it's using
decodeUtf8, which can throw exceptions from pure code for invalid UTF8
sequences. I would prefer decodeUtf8With lenientDecode. Actually, my
*real* preference would be that a lenient decode was the default so
that we aren't exposing a partial function as the default way to
decode bytes.

Michael

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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Joachim Breitner
Hi,

Am Freitag, den 09.03.2012, 13:44 +0200 schrieb Michael Snoyman:
 On Fri, Mar 9, 2012 at 1:40 PM, Joachim Breitner
 m...@joachim-breitner.de wrote:
 
  I was about to suggest to merge this into the convertible package (to
  fight package proliferation), but found that it seems it is already
  there:
  http://hackage.haskell.org/packages/archive/convertible-text/0.4.0.2/doc/html/src/Data-Convertible-Instances-Text.html


 I'm the author of convertible-text, and I consider it deprecated (it's
 marked as such in the synopsis).

sorry, I got confused. In convertible itself, there is 

-- 
Joachim Breitner
  e-Mail: m...@joachim-breitner.de
  Homepage: http://www.joachim-breitner.de
  Jabber-ID: nome...@joachim-breitner.de


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] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Joachim Breitner
Hi,

Am Freitag, den 09.03.2012, 13:44 +0200 schrieb Michael Snoyman:
 On Fri, Mar 9, 2012 at 1:40 PM, Joachim Breitner
 m...@joachim-breitner.de wrote:
 
  I was about to suggest to merge this into the convertible package (to
  fight package proliferation), but found that it seems it is already
  there:
  http://hackage.haskell.org/packages/archive/convertible-text/0.4.0.2/doc/html/src/Data-Convertible-Instances-Text.html


 I'm the author of convertible-text, and I consider it deprecated (it's
 marked as such in the synopsis).

sorry, I got confused by the two packages. In convertible itself, there is 
http://hackage.haskell.org/packages/archive/convertible/1.0.11.1/doc/html/src/Data-Convertible-Instances-Text.html
which only converts between String and the two Text types, but not
between ByteString because the encoding is not know there.

And sorry for the partial mail.

Greetings,
Joachim

-- 
Joachim Breitner
  e-Mail: m...@joachim-breitner.de
  Homepage: http://www.joachim-breitner.de
  Jabber-ID: nome...@joachim-breitner.de

-- 
Joachim nomeata Breitner
  m...@joachim-breitner.de  |  nome...@debian.org  |  GPG: 0x4743206C
  xmpp: nome...@joachim-breitner.de | http://www.joachim-breitner.de/



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] If you'd design a Haskell-like language, what would you do different?

2012-03-09 Thread Ketil Malde
Jerzy Karczmarczuk jerzy.karczmarc...@unicaen.fr writes:

 and the source of it power - if I might cite you - is that we don't see
 the difference between an object and the process which creates it.

Interestingly, according to Wikipedia's article on type system:

  A type system associates a type with each computed value.

but later cites Pierce:

  a tractable syntactic framework for classifying phrases according to
  the kinds of values they compute

While the former might be said to avoid _|_ by defining it to not be a
value that is computed, the latter clearly must include it, as a
the computation of a phrase might not terminate (as longs as the
language is Turing-complete, of course).

Anyway, I think also non-lazy languages has bottom inhabiting their
types, it's just that since it leads more immediately to failure, it's
not usually taken into account.

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants

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


Re: [Haskell-cafe] If you'd design a Haskell-like language, what would you do different?

2012-03-09 Thread Heinrich Apfelmus

Jerzy Karczmarczuk wrote:

Well...
Personally I hate thinking about bottom as value. I don't do this. I
NEVER teach that. And, I am a lazy guy, almost all my Haskell programs
are strongly based on laziness.

I'll tell you what I teach, and you might throw some tomatoes...
The fundamental thing that differentiates Haskell from other languages
and the source of it power - if I might cite you - is that we don't see
the difference between an object and the process which creates it.  (The
difference demands that we speak about the call-by-need, etc...)
The bottom, as sin (2*pi), or Text may be seen as processes. Anyway, a
lazy list IS a process /par excellence/. The _|_ entity is a process
which refuses to give you a value (or does it in a deadly way). Your
program manipulates processes. A process in some computational context
must do something - or not. The bottom never does anything useful.


While it's ultimately an issue of nomenclature, applying the terminus 
value to _|_ is a good idea, because it allows us to answer questions 
like the following:


Question: What is (the denotation of, the value of)

   x = and $ take 5 $ cycle [True,False]
   where cycle xs = fix (xs++)

Answer:

   x = False

If you treat _|_ as a value, this answer can be obtained by 
straightforward algebraic manipulation. If you treat _|_ as an 
operational construct, you will have to perform graph reduction to see 
the answer, but then you have to worry about the *order* in which you 
perform your reduction steps.


It's not wrong to perform graph reduction, and any student should do it 
at one point in their lives, but the restriction to operational 
semantics would miss an important abstraction that is part of the 
Haskell spirit.



Best regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com


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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Sönke Hahn
Hi Joachim!

Joachim Breitner wrote:
 you could elaborate the documenatation “Assumes UTF-8” – I guess this
 only applies to the two ByteString variants, as String and Text _should_
 contain unicode codepoints and no encoding. Not that someone tries to
 use a String where each Char corresponds to a byte in a UTF-8 encoded
 string and thinks he can convert it correctly.

Good point. I added a longer comment (in the repo).
 
 I was about to suggest to merge this into the convertible package (to
 fight package proliferation), but found that it seems it is already
 there:
 http://hackage.haskell.org/packages/archive/convertible-
text/0.4.0.2/doc/html/src/Data-Convertible-Instances-Text.html

I am aware of the Convertible class (and I really like it, btw.). But I 
wanted to allow for explicit string conversion. Data.Convertible.convert 
includes conversions with information loss (e.g. Float - Int), while 
Data.String.Conversions.convertString (converts only strings and) preserves 
information in all cases.

Cheers,
Sönke



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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Sönke Hahn
Michael Snoyman wrote:
 I'm the author of convertible-text, and I consider it deprecated (it's
 marked as such in the synopsis).
 
 As far as string-conversions, I'm a little concerned that it's using
 decodeUtf8, which can throw exceptions from pure code for invalid UTF8
 sequences. I would prefer decodeUtf8With lenientDecode.

I wasn't aware of 'decodeUtf8With lenientDecode'. I changed it in the repo.

 Actually, my
 *real* preference would be that a lenient decode was the default so
 that we aren't exposing a partial function as the default way to
 decode bytes.

Are you talking about the default in decodeUtf8? (If yes, I tend to agree.)

Sönke



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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.1

2012-03-09 Thread Michael Snoyman
On Fri, Mar 9, 2012 at 4:36 PM, Sönke Hahn sh...@cs.tu-berlin.de wrote:
 Michael Snoyman wrote:
 I'm the author of convertible-text, and I consider it deprecated (it's
 marked as such in the synopsis).

 As far as string-conversions, I'm a little concerned that it's using
 decodeUtf8, which can throw exceptions from pure code for invalid UTF8
 sequences. I would prefer decodeUtf8With lenientDecode.

 I wasn't aware of 'decodeUtf8With lenientDecode'. I changed it in the repo.

 Actually, my
 *real* preference would be that a lenient decode was the default so
 that we aren't exposing a partial function as the default way to
 decode bytes.

 Are you talking about the default in decodeUtf8? (If yes, I tend to agree.)

Yes, that's what I meant.

Michael

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


Re: [Haskell-cafe] ANNOUNCE: string-conversions-0.2

2012-03-09 Thread Sönke Hahn
I've uploaded a new version to hackage incorporating suggestions from 
Joachim Breitner, Michael Snoyman and (offlist) Matthias Fischmann.

The package now supplies (), a generic function for string concatenation.
(Under ghc = 7.4 this is a re-export from Data.Monoid to avoid name 
clashes.)

Sönke

Sönke Hahn wrote:

 Hi all!
 
 string-conversions is a very simple package to facilitate dealing with
 different string types. It provides a simple type class that allows you to
 convert between values of different string types. It also provides type
 synonyms for these string types.
 
 Supported types are:
 
 - String
 - Strict ByteString
 - Lazy ByteString
 - Strict Text
 - Lazy Text
 
 http://hackage.haskell.org/package/string-conversions
 
 Any comments welcome.
 
 Cheers,
 Sönke



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


[Haskell-cafe] network-conduit proxy

2012-03-09 Thread grant
I am trying to get a proxy working using the network-conduit package on windows.
So I send a request to port 5002 and that gets forwarded to another port 5000 
where I have a simple echo server running.

I made a stab at it, but get intermittent send errors after the first connection

Here is the code:
{-# OPTIONS -Wall #-}
import Data.Conduit
import Data.Conduit.Network
import Network (withSocketsDo)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource

main::IO ()
main = 
  withSocketsDo $ runTCPClient (ClientSettings 5000 localhost) $ 
\src1 sink1 - do
liftIO $ print in tcpclient section
liftIO $ withSocketsDo $ runTCPServer (ServerSettings 5002 Nothing) $ 
  \src sink - do
  liftIO $ print in tcpserver section
  _ - liftIO $ runResourceT $ resourceForkIO $ do
  src1 $$ sink 
  return ()
  src $$ sink1 

  
Thanks for any help,
Grant
  




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


[Haskell-cafe] ANNOUNCE: diagrams 0.5

2012-03-09 Thread Brent Yorgey
I am pleased to announce the release of version 0.5 of diagrams [1], a
full-featured framework and embedded domain-specific language for
declarative drawing. Check out the gallery [2] for examples of what it
can do!

[1] http://projects.haskell.org/diagrams
[2] http://projects.haskell.org/diagrams/gallery.html


Highlights of this release include:

-   A new diagrams-contrib [3] package of user-contributed modules,
which so far contains code for tree drawing, Apollonian gaskets,
planar tilings, wrapped layout, and turtle graphics.

-   Experimental support for animation, built on top of the new active
[4] library.

-   Numerous small additions and improvements, including more general
rounded rectangle shapes and better text support.

-   Much better performance in some common situations, such as laying
out a very long list of diagrams using 'cat' and related
combinators.

-   Added support for GHC 7.4.

See the release notes [5] for complete details, and the diagrams wiki
[6] for help migrating code from 0.4 to 0.5 (changes should be minimal).

[3] http://hackage.haskell.org/package/diagrams%2Dcontrib
[4] http://hackage.haskell.org/package/active
[5] http://projects.haskell.org/diagrams/releases.html
[6] http://www.haskell.org/haskellwiki/Diagrams/Migrate0.5


Try it out
--

For the truly impatient:

cabal install gtk2hs-buildtools
cabal install diagrams

Diagrams is supported under GHC 6.12, 7.0, 7.2, and 7.4. However,
getting cairo to build can be tricky on some platforms; see the
diagrams wiki [8] for more information and workarounds regarding
specific platforms. (A new native SVG backend is in the works,
targeted for the 0.6 release.)

To get started with diagrams, read the quick tutorial [9], which will
introduce you to the fundamentals of the framework.

For those who are even less impatient but want to really dig in and use
the power features, read the user manual [10].

[7]  http://projects.haskell.org/gtk2hs/development/#development
[8]  http://www.haskell.org/haskellwiki/Diagrams
[9]  http://projects.haskell.org/diagrams/tutorial/DiagramsTutorial.html
[10] http://projects.haskell.org/diagrams/manual/diagrams-manual.html


Get involved


Subscribe to the project mailing list [11], and/or come hang out in
the #diagrams IRC channel on freenode.org for help and
discussion. Make some diagrams. Fix some bugs [12]. Submit your cool
examples for inclusion in the gallery or your cool code for inclusion
in the diagrams-contrib package!

[11] http://groups.google.com/group/diagrams-discuss
[12] http://code.google.com/p/diagrams/issues/list


Happy diagramming!

Brought to you by the diagrams team:

-   Peter Hall
-   Ian Ross
-   Michael Sloan
-   Ryan Yates
-   Brent Yorgey

with contributions from:

-   Sam Griffin
-   Claude Heiland-Allen
-   John Lato
-   Vilhelm Sjoberg
-   Luite Stegeman
-   Kanchalai Suveepattananont
-   Scott Walck


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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread Alexander V Vershilov
Hello.

I'm not expert but first you should not use Network sockets, because everything
is included into Data.Conduit.Network, just use high level API.
Second, you should use not server inside client but client inside server:

so you can make such a code [1]:


{-# OPTIONS -Wall #-}
import Data.Conduit
import Data.Conduit.Network
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.Lifted (fork)

main::IO ()
main =
  runTCPServer (ServerSettings 5002 Nothing) $ \clientSrc clientSink - do
liftIO $ runTCPClient (ClientSettings 5000 localhost) $ \serverSrc 
serverSink - do
  _ - liftIO $ fork $ runResourceT $ serverSrc $$ clientSink
  clientSrc $$ serverSink

tested and works

[1] https://gist.github.com/2008113

--
Alexander V Vershilov

Fri, Mar 09, 2012 at 05:44:29PM +, grant wrote
 I am trying to get a proxy working using the network-conduit package on 
 windows.
 So I send a request to port 5002 and that gets forwarded to another port 5000 
 where I have a simple echo server running.
 
 I made a stab at it, but get intermittent send errors after the first 
 connection
 
 Here is the code:
 {-# OPTIONS -Wall #-}
 import Data.Conduit
 import Data.Conduit.Network
 import Network (withSocketsDo)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource
 
 main::IO ()
 main = 
   withSocketsDo $ runTCPClient (ClientSettings 5000 localhost) $ 
 \src1 sink1 - do
 liftIO $ print in tcpclient section
 liftIO $ withSocketsDo $ runTCPServer (ServerSettings 5002 Nothing) $ 
   \src sink - do
   liftIO $ print in tcpserver section
   _ - liftIO $ runResourceT $ resourceForkIO $ do
   src1 $$ sink 
   return ()
   src $$ sink1 
 
   
 Thanks for any help,
 Grant
   
 
 
 
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread grant
When I run the code you suggested on windows I get the following error:
  getAddrInfo: does not exist (error 10093)
which probably refers to  http://trac.haskell.org/network/ticket/32

After adding withSocketsDo I get a little further, but get the following error 
after sending data through the proxy:

netproxy2: Network.Socket.ByteString.recv: failed (Unknown error)

Any ideas?
Thanks so much for your help with this.
Grant







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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread Alexander V Vershilov

For first error it seems best way will be patching conduit-network as it 
done it warp [1]. I don't know how to deal with second error.


[1] 
http://hackage.haskell.org/packages/archive/warp/1.1.0.1/doc/html/src/Network-Wai-Handler-Warp.html#runSettings

--
Alexander V Vershilov

Fri, Mar 09, 2012 at 07:52:39PM +, grant wrote
 When I run the code you suggested on windows I get the following error:
   getAddrInfo: does not exist (error 10093)
 which probably refers to  http://trac.haskell.org/network/ticket/32
 
 After adding withSocketsDo I get a little further, but get the following 
 error 
 after sending data through the proxy:
 
 netproxy2: Network.Socket.ByteString.recv: failed (Unknown error)
 
 Any ideas?
 Thanks so much for your help with this.
 Grant
 
 
 
 
 
 
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


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


[Haskell-cafe] Global Arrays

2012-03-09 Thread Clark Gaebel
In Haskell, what's the canonical way of declaring a top-level array
(Data.Vector of a huge list of doubles, in my case)? Performance is
key in my case.

The straightforward way would just be something like:

globalArray :: V.Vector Double
globalArray = V.fromList [ huge list of doubles ]
{-# NOINLINE globalArray #-}

However, I don't want to have to run the fromList at runtime. Not only
would this mean a bigger executable (having to store a linked list,
instead of an array), it would be quite inefficient since we don't
even use the source list!

Therefore, I was thinking of storing the array in a C file:

static const double globalArray[] = { huge list of doubles };
double* getGlobalArray() { return globalArray; }
intgetGlobalArraySize() { return
sizeof(globalArray)/sizeof(globalArray[0]); }

And importing it in haskell witht he FFI, followed with an unsafeCast:

foreign import ccall unsafe getGlobalArray c_globalArray :: Ptr CDouble
foreign import ccall unsafe getGlobalArraySize c_globalArraySize :: CInt

globalArray :: V.Vector Double
globalArray = V.unsafeCast $ unsafeFromForeignPtr0 (unsafePerformIO $
newForeignPtr_ c_globalArray) (fromIntegral c_globalArraySize)
{-# NOINLINE globalArray #-}

But this version (clearly) is full of unsafety. Is there a better
way that I haven't thought of?

Regards,
  - clark

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


Re: [Haskell-cafe] Global Arrays

2012-03-09 Thread Lyndon Maydwell
Could template-Haskell be used somehow?

- Lyndon Maydwell
On Mar 10, 2012 4:50 AM, Clark Gaebel cgae...@csclub.uwaterloo.ca wrote:

 In Haskell, what's the canonical way of declaring a top-level array
 (Data.Vector of a huge list of doubles, in my case)? Performance is
 key in my case.

 The straightforward way would just be something like:

 globalArray :: V.Vector Double
 globalArray = V.fromList [ huge list of doubles ]
 {-# NOINLINE globalArray #-}

 However, I don't want to have to run the fromList at runtime. Not only
 would this mean a bigger executable (having to store a linked list,
 instead of an array), it would be quite inefficient since we don't
 even use the source list!

 Therefore, I was thinking of storing the array in a C file:

 static const double globalArray[] = { huge list of doubles };
 double* getGlobalArray() { return globalArray; }
 intgetGlobalArraySize() { return
 sizeof(globalArray)/sizeof(globalArray[0]); }

 And importing it in haskell witht he FFI, followed with an unsafeCast:

 foreign import ccall unsafe getGlobalArray c_globalArray :: Ptr CDouble
 foreign import ccall unsafe getGlobalArraySize c_globalArraySize :: CInt

 globalArray :: V.Vector Double
 globalArray = V.unsafeCast $ unsafeFromForeignPtr0 (unsafePerformIO $
 newForeignPtr_ c_globalArray) (fromIntegral c_globalArraySize)
 {-# NOINLINE globalArray #-}

 But this version (clearly) is full of unsafety. Is there a better
 way that I haven't thought of?

 Regards,
  - clark

 ___
 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] ANNOUNCE: pipes-core 0.0.1

2012-03-09 Thread Paolo Capriotti
I'm pleased to announce the release of version 0.0.1 of pipes-core, a
library for efficient, safe and compositional IO, similar in scope to
iteratees and conduits.

http://hackage.haskell.org/package/pipes-core

This is a reimplementation of the original 'Pipe' concept by Gabriel
Gonzales. The package documentation contains an introduction to Pipes
and a detailed tutorial, so here I'll just outline some of the
differences from the original version:

 - A single composition operator. Strict composition has been
removed, since its role wasn't actually that clear, and its purpose
for resource finalization has been replaced by better constructs (see
below).
 - A new primitive 'tryAwait', which makes it possible to recover from
termination of an upstream pipe. Using 'tryAwait' you can write pipes
that are able to consume all their input and return a value (like
iteratees or Conduit's sinks can), and stateful pipes that can make
use of their final state before terminating.
 - Full exception safety and exception-handling primitives. Pipes have
been augmented with 'catch' and 'finally' primitives, which allow you
to recover from exceptions and ensure finalization of resources within
the Pipe monad. There's no more need to use resource-simple or monadic
regions together with Pipes.
- Multi-channel pipes. This is a generalization of Arrows using sums
instead of pairs for contexts. We provide a number of combinators that
allow you to combine Pipes in much the same way as Arrows, although
there is not unfortunately an alternative for the Arrow syntax.

Together with pipes-core, I also released a number of accessory
packages with various utilities. Here is a complete list:

 * pipes-extra: File readers and writers, chunk pipes.
   http://hackage.haskell.org/package/pipes-extra

 * pipes-attoparsec: Utilities to convert a parser into a pipe.
   http://hackage.haskell.org/package/pipes-attoparsec

 * pipes-conduit: Conduit adapters.
   http://hackage.haskell.org/package/pipes-conduit

 * pipes-network: Utilities to deal with sockets. Ported from conduit.
   http://hackage.haskell.org/package/pipes-network

 * pipes-zlib: Pipes to deal with zipped data. Ported from conduit.
   http://hackage.haskell.org/package/pipes-zlib

This is an experimental release, but it should be equipped with all
the functionality needed to write serious applications. I encourage
people to try it out and send feedback if anything looks too
simplistic or too limiting.

BR,
Paolo Capriotti

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


Re: [Haskell-cafe] Global Arrays

2012-03-09 Thread John Meacham
On Fri, Mar 9, 2012 at 12:48 PM, Clark Gaebel
cgae...@csclub.uwaterloo.ca wrote:
 static const double globalArray[] = { huge list of doubles };
 double* getGlobalArray() { return globalArray; }
 int        getGlobalArraySize() { return
 sizeof(globalArray)/sizeof(globalArray[0]); }

 And importing it in haskell witht he FFI, followed with an unsafeCast:

 foreign import ccall unsafe getGlobalArray c_globalArray :: Ptr CDouble
 foreign import ccall unsafe getGlobalArraySize c_globalArraySize :: CInt

You can use Data.Array.Storable to do this.
http://hackage.haskell.org/packages/archive/array/0.3.0.3/doc/html/Data-Array-Storable.html

Also, there is no need to create stub C functions, you can foreign import
the array directly
And if you don't want to cast between CDouble and Double you can declare
your array to be of HsDouble and #include HsFFI.h

const HsDouble globalArray[] = { huge list of doubles };
foreign import ccall unsafe globalArray :: Ptr Double

John

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


Re: [Haskell-cafe] Global Arrays

2012-03-09 Thread Clark Gaebel
What's the advantage of using D.A.Storable over D.Vector? And yes,
good call with creating an array of HSDouble directly. I didn't think
of that!

On Fri, Mar 9, 2012 at 8:25 PM, John Meacham j...@repetae.net wrote:
 On Fri, Mar 9, 2012 at 12:48 PM, Clark Gaebel
 cgae...@csclub.uwaterloo.ca wrote:
 static const double globalArray[] = { huge list of doubles };
 double* getGlobalArray() { return globalArray; }
 int        getGlobalArraySize() { return
 sizeof(globalArray)/sizeof(globalArray[0]); }

 And importing it in haskell witht he FFI, followed with an unsafeCast:

 foreign import ccall unsafe getGlobalArray c_globalArray :: Ptr CDouble
 foreign import ccall unsafe getGlobalArraySize c_globalArraySize :: CInt

 You can use Data.Array.Storable to do this.
 http://hackage.haskell.org/packages/archive/array/0.3.0.3/doc/html/Data-Array-Storable.html

 Also, there is no need to create stub C functions, you can foreign import
 the array directly
 And if you don't want to cast between CDouble and Double you can declare
 your array to be of HsDouble and #include HsFFI.h

 const HsDouble globalArray[] = { huge list of doubles };
 foreign import ccall unsafe globalArray :: Ptr Double

    John


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


Re: [Haskell-cafe] Global Arrays

2012-03-09 Thread John Meacham
On Fri, Mar 9, 2012 at 5:49 PM, Clark Gaebel
cgae...@csclub.uwaterloo.ca wrote:
 What's the advantage of using D.A.Storable over D.Vector? And yes,
 good call with creating an array of HSDouble directly. I didn't think
 of that!

Oh, looks like D.Vector has an unsafeFromForeignPtr too, I didn't see
 that. so D.Vector should work just fine. :)

John

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


Re: [Haskell-cafe] ANNOUNCE: pipes-core 0.0.1

2012-03-09 Thread Mario Blažević

On 12-03-09 07:36 PM, Paolo Capriotti wrote:

I'm pleased to announce the release of version 0.0.1 of pipes-core, a
library for efficient, safe and compositional IO, similar in scope to
iteratees and conduits.


I like your design, it seems to strike a good balance between 
elegance and practicality. The only thing missing for the latter is a 
deeper support for chunking. Of course, that would probably destroy some 
of the elegance [1]. I don't think that problem has been solved in any 
of the enumerator/iteratee/pipe/wire/conduit libraries so far.


Did you consider adding some stream-splitting and merging pipes, 
like those in the SCC package [2] or those described in the last 
Monad.Reader issue [3]? Your arrow-like combinators seem well thought 
out, but they don't go very far.



[1] http://www.haskell.org/pipermail/haskell-cafe/2010-August/082540.html
[2] 
http://hackage.haskell.org/packages/archive/scc/0.7.1/doc/html/Control-Concurrent-SCC-Sequential.html#g:24

[3] http://themonadreader.files.wordpress.com/2011/10/issue19.pdf


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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread grant
I've tried running the code with runTCPServer first but I get
 recv: invalid argument (Bad file descriptor) on ubuntu (virtualbox) 
and when running on windows 
I get Network.Socket.ByteString.recv: failed (Unknown error).

Also, it seems odd that when I run this code   https://gist.github.com/2010354  
 
that it doesn't print END   serverSrc clientSink. 
Is this the expected behaviour or are resources not being closed?
Again the same thing happens when running on Ubuntu.

{- here is the output ...
C:\haskellnetproxy4
START clientSrc serverSink
START serverSrc clientSink
END   clientSrc serverSink
START serverSrc clientSink
START clientSrc serverSink
END   clientSrc serverSink
-}

Thanks for any ideas.
Grant


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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread Alexander V Vershilov
As it seems from code runTCPServer registers socket close 
and TCPClient runs it in bracket so all open resources should be
closed. It my last try I add 
  _ - register $ killThread tId
after forking serverSrc $$ clientSink, to kill outter thread explicilty
otherwise it closes thread with error. 

 Is this the expected behaviour or are resources not being closed?

In 'strace' log it seems that both sockets is closed. So I think that 
computation is closed before reaching the end because src $$ sink closed
with error. If you want to run action at the end you can register it

--
Alexander V Vershilov


Sat, Mar 10, 2012 at 05:43:12AM +, grant wrote
 I've tried running the code with runTCPServer first but I get
  recv: invalid argument (Bad file descriptor) on ubuntu (virtualbox) 
 and when running on windows 
 I get Network.Socket.ByteString.recv: failed (Unknown error).
 
 Also, it seems odd that when I run this code   
 https://gist.github.com/2010354   
 that it doesn't print END   serverSrc clientSink. 
 Is this the expected behaviour or are resources not being closed?
 Again the same thing happens when running on Ubuntu.
 
 {- here is the output ...
 C:\haskellnetproxy4
 START clientSrc serverSink
 START serverSrc clientSink
 END   clientSrc serverSink
 START serverSrc clientSink
 START clientSrc serverSink
 END   clientSrc serverSink
 -}
 
 Thanks for any ideas.
 Grant
 
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


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


Re: [Haskell-cafe] network-conduit proxy

2012-03-09 Thread grant
Excellent. registering killThread works great. Hopefully the library will be 
fixed correctly.
Thanks a lot for your help,
Grant


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


Re: [Haskell-cafe] Global Arrays

2012-03-09 Thread Alexandr Alexeev
 what's the canonical way of declaring a top-level array
Did you try State/StateT monads?

10 марта 2012 г. 5:05 пользователь John Meacham j...@repetae.net написал:

 On Fri, Mar 9, 2012 at 5:49 PM, Clark Gaebel
 cgae...@csclub.uwaterloo.ca wrote:
  What's the advantage of using D.A.Storable over D.Vector? And yes,
  good call with creating an array of HSDouble directly. I didn't think
  of that!

 Oh, looks like D.Vector has an unsafeFromForeignPtr too, I didn't see
  that. so D.Vector should work just fine. :)

John

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




-- 
С уважением, Александр
Личный блог: http://eax.me/
Мой форум: http://it-talk.org/
Мой Twitter: http://twitter.com/afiskon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe