Re: [Haskell-cafe] Functors and the Visitor Pattern

2009-06-05 Thread Johan Tibell
On Fri, Jun 5, 2009 at 4:45 AM, wren ng thornton w...@freegeek.org wrote: Johan Tibell wrote: Could you be so kind to give an example for each? In OOP you mean? This cleared things up for me. Thanks! -- Johan ___ Haskell-Cafe mailing list

[Haskell-cafe] Generic polyvariadic printf in Haskell98

2009-06-05 Thread oleg
Evan Klitzke wrote: I'm writing code with hslogger, and I'm finding myself frequently writing things like this: infoM $ printf %s saw %s with %s (show x) (show y) (show z) Indeed writing these `show' is tedious. Fortunately, we can get rid of them, still remaining in Haskell98. The

Re[2]: [Haskell-cafe] Umlauts in command line arguments

2009-06-05 Thread Bulat Ziganshin
Hello Eric, Friday, June 5, 2009, 12:17:42 AM, you wrote: I'm using ghc 6.10.2 on Win XP. Are there any known solutions for this problem? Your question has inspired me to add a System.Environment.UTF8 module to utf8-string 0.3.5 This module behaves like the System.IO.UTF8 wrapper. it is

Re: [Haskell-cafe] Generic polyvariadic printf in Haskell98

2009-06-05 Thread Erik de Castro Lopo
o...@okmij.org wrote: Still, the code is a bit unsatisfactory because of the appearances of error in pr_aux functions. The errors like passing too many or too few arguments to printf (as demanded by the format specification) are caught only at run-time. We can certainly do better. I'd love

Re: [Haskell-cafe] Fast code question

2009-06-05 Thread Ketil Malde
Bartosz Wójcik bar...@sudety.it writes: myConcat' :: (Integral a) = Integer - [a] - [Integer] : myConcat' acc (x:xs) = case x `mod` 16 of : 10 - fail $ show acc 11 - fail $ show acc 14 - fail $ show acc

[Haskell-cafe] Record initialise question

2009-06-05 Thread John Ky
Hi all, I have some sample code: full = do let myOrder = initOrder { item = Just initItem { itemId = Something } , operation = Just Buy } putStrLn $ show myOrder return () This is just a test project,

[Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Martijn van Steenbergen
Hello, Suppose I have two projects: 1) one that defines a monad transformer and an accompanying type class that captures my monad-specific operations and 2) one that uses the other project, combining the monad transformer with, say, Parsec. Now while writing my Parsec parser I want to use

Re: [Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread Ketil Malde
GüŸnther Schmidt gue.schm...@web.de writes: I need a data structure as in my example without the [] being possible to be empty. Well, a list can by definition be empty, so this is clearly impossible. The best you can do is to hide the constructors and have smart constructor functions that

Re: [Haskell-cafe] Record initialise question

2009-06-05 Thread Martijn van Steenbergen
Hi John, John Ky wrote: full = do let myOrder = init -- [1] { item = Just init { itemId = Something } , operation = Just Buy } putStrLn $ show myOrder return () Where initOrder and initItem

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Ryan Ingram
From what I understand, the current best practices are to build your package dependencies like so: ParsecMyMonadT MyMonadT_Parsec -- orphan instances go here ProjectPackage This does mean splitting up your project into three packages, but decouples the orphan instance into its own

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Stephan Friedrichs
Hi, it's alomost the same problem when you're writing a library with optional quickcheck test cases: Where to put the Arbitrary instances? - You can't put them into quickcheck - You don't want to put them in the library (because of the quickcheck dependency) - So you have to declare them

Re: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Martijn van Steenbergen
Thomas ten Cate wrote: Possible, yes. Efficient, not really. inTwain = foldr (\x (ls, rs) - if length ls == length rs then (x:ls, rs) else (x:(init ls), (last ls):rs)) ([], []) But this uses length and init and last all of which are recursive functions. I consider that cheating: only

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Claus Reinke
From what I understand, the current best practices are to build your package dependencies like so: ParsecMyMonadT MyMonadT_Parsec -- orphan instances go here ProjectPackage This does mean splitting up your project into three packages, but decouples the orphan instance into its own package

Re: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Martijn van Steenbergen
Geoffrey Marchant wrote: The linked paper appears to show the right style. This appears to satisfy the conditions, however: inTwain as = let (x,y,_) = foldr (\a (r,s,t) - case (t) of {b:(b':bs) - (r,a:s,bs); _ - (a:r,s,t)}) ([],[],as) as in (x,y) This one is very interesting. Thanks. :-) It

Re: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Ketil Malde
Martijn van Steenbergen mart...@van.steenbergen.nl writes: inTwain = foldr (\x (ls, rs) - if length ls == length rs then (x:ls, rs) else (x:(init ls), (last ls):rs)) ([], []) But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr

Re: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Ketil Malde
Martijn van Steenbergen mart...@van.steenbergen.nl writes: inTwain as = let (x,y,_) = foldr (\a (r,s,t) - case (t) of {b:(b':bs) - (r,a:s,bs); _ - (a:r,s,t)}) ([],[],as) as in (x,y) This one is very interesting. Yes, neat. I'm not too happy with the whole list as part of the initial

[Haskell-cafe] specialization in type classes

2009-06-05 Thread Cetin Sert
module IOStream where import System.IO import System.IO.Unsafe class Out a where out :: a → String instance Show a ⇒ Out a where out = show instance Out String where {-# SPECIALISE out :: String → String #-} out = id instance Out Char where {-# SPECIALISE out :: Char → String #-}

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread David Menendez
On Fri, Jun 5, 2009 at 7:25 AM, Claus Reinke claus.rei...@talk21.com wrote: If ProjectPackage actually depends on the existence of those orphan instances, plan B is to delay instance resolution, from library to clients, so instead of importing the orphan instances module ProjectPackage where

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Miguel Mitrofanov
Do you really need a class? Maybe, a simple data type would do? So, instead of class MyMonad m where myVal1 :: m a myVal2 :: m a - m [a] instance Monad m = MyMonad (MyMonadT m) where myVal1 = foo myVal2 = bar you can write (in your first package) something like data MyMonad m

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Miguel Mitrofanov
Miguel Mitrofanov wrote on 05.06.2009 16:53: myMonadT :: Monad m = MyMonad m Sorry, I've meant myMonadT :: Monad m = MyMonad (MyMonadT m) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Claus Reinke
| bar :: (C T) = T | *Main :t bar | | interactive:1:0: | No instance for (C T) | arising from a use of `bar' at interactive:1:0-2 | Possible fix: add an instance declaration for (C T) | In the expression: bar I'm not sure where that comes from, but it does seem to be an

[Haskell-cafe] Re: specialization in type classes

2009-06-05 Thread Cetin Sert
Now there's also a stackoverflow question for this: http://stackoverflow.com/questions/955711/specialization-in-type-classes-using-ghc Any help highly appreciated! 2009/6/5 Cetin Sert cetin.s...@gmail.com module IOStream where import System.IO import System.IO.Unsafe class Out a where

Re: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Malcolm Wallace
Martijn van Steenbergen mart...@van.steenbergen.nl wrote: But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion. I think the key is to pick your intermediate data-structure wisely. A pair of queues would be my

Re: [Haskell-cafe] Non Empty List?

2009-06-05 Thread Conor McBride
Hi folks data NE x = x : Maybe (NE x) ? It's Applicative in at least four different ways. Can anyone find more? Conor On 5 Jun 2009, at 01:34, Edward Kmett wrote: Günther, Miguel had the easiest suggestion to get right: Your goal is to avoid the redundant encoding of a list of one

[Haskell-cafe] web musing

2009-06-05 Thread Conor McBride
Comrades I'm in a perplexing situation and I'd like to appeal to the sages. I've never written anything other than static HTML in my life, and I'd like to make a wee web service: I've heard some abbreviations, but I don't really know what they mean. I've got a function (possibly the identity,

Re: [Haskell-cafe] web musing

2009-06-05 Thread Max Rabkin
On Fri, Jun 5, 2009 at 5:18 PM, Conor McBrideco...@strictlypositive.org wrote: Will I need to ask systems support to let me install some haskelly sort of web server? Looks likely, I suppose. In general, what's an easy way to put a web front end on functionality implemented in Haskell? For

Re: [Haskell-cafe] web musing

2009-06-05 Thread Jason Dagit
On Fri, Jun 5, 2009 at 8:18 AM, Conor McBride co...@strictlypositive.orgwrote: Comrades I'm in a perplexing situation and I'd like to appeal to the sages. I've never written anything other than static HTML in my life, and I'd like to make a wee web service: I've heard some abbreviations,

Re: [Haskell-cafe] web musing

2009-06-05 Thread Justin Bailey
I bet they have PHP on the server already. Write your program so it takes input from standard in and writes to standard out. Then just run your executable from PHP and write to its pipe. Instant web service! On Fri, Jun 5, 2009 at 8:18 AM, Conor McBrideco...@strictlypositive.org wrote: Comrades

Re: [Haskell-cafe] Re: specialization in type classes

2009-06-05 Thread Ryan Ingram
The SPECIALIZE pragma doesn't do what you think; those implementations are already as specialized as they get. You can enable OverlappingInstances, but the big problem is that it doesn't really work; consider this function: foo :: Show a = a - String foo x = out x question = foo hello What

[Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Vasili I. Galchin
Hello, The following is a fragment in my cabal file: Executable GraphPartitionTest Main-Is:Swish.HaskellRDF.GraphPartitionTest.hs Other-modules: Swish.HaskellRDF.GraphPartition Swish.HaskellRDF.GraphClass

Re: [Haskell-cafe] web musing

2009-06-05 Thread Philippa Cowderoy
On Fri, 2009-06-05 at 16:18 +0100, Conor McBride wrote: I've got a function (possibly the identity, possibly const , who knows?) assistant :: String - String and I want to make a webpage with an edit box and a submit button. If I press the submit button with the edit box containing

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Gwern Branwen
-BEGIN PGP SIGNED MESSAGE- Hash: SHA512 On Fri, Jun 5, 2009 at 3:33 PM, Vasili I. Galchin wrote: Hello, The following is a fragment in my cabal file: Executable GraphPartitionTest Main-Is:Swish.HaskellRDF.GraphPartitionTest.hs Other-modules:

Re: [Haskell-cafe] Fast code question

2009-06-05 Thread Bartosz Wójcik
Packed Decimal downloaded on pc is just a stream of bytes without any comma. I was supposed to reformat data. If I undersdand bytestring-csv library, it parses csv format data. Thanks for the hint. I'll investigate next time when I have to deal with huge files. Bartek On Thursday 04 June 2009

Re: [Haskell-cafe] Fast code question

2009-06-05 Thread Bartosz Wójcik
Integer was on purpose. One of the fields was 14 digits number. Usually I parse EBCDIC directly on mainframe. This time it was exception. Bartek On Thursday 04 June 2009 22:38:53 Michael Snoyman wrote: I *do* know what Packed Decimal is; at my previous job, I actually had a whole Haskell

[Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread Tillmann Rendel
Hi, please write to the whole list, not just me. There are a lot of people around who can help you. MH wrote: Rendel do you mind to explain to me how Container a = Many a (Container [a]) prevents user from creating an empty list? I did try the following: let a = Many string a :: Container

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Vasili I. Galchin
for directory structure I Swish-0.2.1/Swish/HaskellRDF and Swish-0.2.1/Swish/HaskellUtils ... there are deeper directories but that distract from the discussion ... to make things concete: 1) swish.cabal is directly under Swish-0.2.1 2) GraphPartitionTest.hs is under

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Gwern Branwen
-BEGIN PGP SIGNED MESSAGE- Hash: SHA512 On Fri, Jun 5, 2009 at 4:10 PM, Vasili I. Galchin wrote: for directory structure I Swish-0.2.1/Swish/HaskellRDF and Swish-0.2.1/Swish/HaskellUtils ... there are deeper directories but that distract from the discussion ... to make things concete:

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Vasili I. Galchin
At work I am using Windose ... so I use runhaskell .. I don't have build Vasili On Fri, Jun 5, 2009 at 3:28 PM, Gwern Branwen gwe...@gmail.com wrote: -BEGIN PGP SIGNED MESSAGE- Hash: SHA512 On Fri, Jun 5, 2009 at 4:10 PM, Vasili I. Galchin wrote: for directory structure I

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Vasili I. Galchin
getting farther . Executable GraphPartitionTest Hs-source-dirs: Swish/ added this Main-Is:HaskellRDF/GraphPartitionTest.hschanged to a real filesystem path Other-modules: HaskellRDF.GraphPartition

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Gwern Branwen
-BEGIN PGP SIGNED MESSAGE- Hash: SHA512 On Fri, Jun 5, 2009 at 4:49 PM, Vasili I. Galchin wrote: getting farther . Executable GraphPartitionTest Hs-source-dirs: Swish/ Main-Is: HaskellRDF/GraphPartitionTest.hsfilesystem path

Re: [Haskell-cafe] Cabal addressibility problem

2009-06-05 Thread Ross Mellgren
If your module statements say Swish in them, e.g. module Swish.HaskellUtils.TestHelpers where then you should probably have no hs-source-dirs (or hs-source-dirs: .) and then use Swish.HaskellUtils.TestHelpers. But leave Main-Is: as you have it. -Ross On Jun 5, 2009, at 4:49 PM,

[Haskell-cafe] Is it possible to do type-level arithmetic without UndeciableInstances?

2009-06-05 Thread Ryan Ingram
{-# LANGUAGE TypeFamilies #-} module PeanoArith data Z = Z data S n = S n So, this type family works just fine: type family Plus a b type instance Plus Z b = b type instance Plus (S a) b = S (Plus a b) As does this one: type family Minus a b type instance Minus a Z = Z type instance

Re: [Haskell-cafe] Is it possible to do type-level arithmetic without UndeciableInstances?

2009-06-05 Thread Reid Barton
On Fri, Jun 05, 2009 at 01:58:33PM -0700, Ryan Ingram wrote: I tried several different implementations for Times but I was unable to come up with one that passed the type family termination checker. Is there a way to do so? Here is a solution. I don't understand exactly why this works while

Re: [Haskell-cafe] web musing

2009-06-05 Thread Iavor Diatchki
Hi Conor, As someone pointed out, CGI is one way to go. Another option is to write a small Haskell web server. This path is better if you have an app that needs to keep state, ans uses the browser mostly as a GUI. I have just made a package that should make doing this fairly easy. I have not

Re: [Haskell-cafe] Is it possible to do type-level arithmetic without UndeciableInstances?

2009-06-05 Thread Paul Johnson
This is a bit beyond my normal level of expertise, but if I understand it correctly the type checker is normally limited to type functions that are primitive recursive (http://en.wikipedia.org/wiki/Primitive_recursive_function). This means that they are guaranteed to terminate, but on the

[Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread MH
I actually meant data Container a = Many a(Container a) but here is what I don't understand (fyi, I am a beginner) how can you construct this container? I can do let a = Many somestring - and I will get back a function but I can not do let a = Many 'a' somestring - because the second param is

Re: [Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread Ketil Malde
MH mha...@gmail.com writes: data Container a = Many a(Container a) but here is what I don't understand (fyi, I am a beginner) how can you construct this container? I can do let a = Many somestring - and I will get back a function but I can not do let a = Many 'a' somestring - because the

Re: [Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread Jason Dagit
On Fri, Jun 5, 2009 at 2:58 PM, MH mha...@gmail.com wrote: I actually meant data Container a = Many a(Container a) but here is what I don't understand (fyi, I am a beginner) how can you construct this container? I can do I think I saw the above definition described as a coalgebra or

Re: [Haskell-cafe] Re: Non Empty List?

2009-06-05 Thread Luke Palmer
On Fri, Jun 5, 2009 at 4:13 PM, Jason Dagit da...@codersbase.com wrote: On Fri, Jun 5, 2009 at 2:58 PM, MH mha...@gmail.com wrote: I actually meant data Container a = Many a(Container a) but here is what I don't understand (fyi, I am a beginner) how can you construct this container? I

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread wren ng thornton
Martijn van Steenbergen wrote: Hello, Suppose I have two projects: 1) one that defines a monad transformer and an accompanying type class that captures my monad-specific operations and 2) one that uses the other project, combining the monad transformer with, say, Parsec. Now while writing

[Haskell-cafe] Pike's Newsqueak talk

2009-06-05 Thread Tim Newsham
I just watched http://video.google.com/videoplay?docid=810232012617965344 It's a great talk that is suprisingly relevant to Haskell programming (although at first blush it looks a bit unrelated). (It refs a lot of older work that actually led me to Haskell in the first place by way of

Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-05 Thread Antoine Latter
On Fri, Jun 5, 2009 at 6:38 PM, wren ng thorntonw...@freegeek.org wrote: 4) Define a newtype of MyMonadT Parsec and declare instances of MyMonad and Parsec for it. Yes, I know Parsec is (an alias for) a data type, not a type class. But for the general problem, using newtype wrappers is

[Haskell-cafe] Re: Pike's Newsqueak talk

2009-06-05 Thread Chung-chieh Shan
Tim Newsham news...@lava.net wrote in article pine.bsi.4.64.0906051510070.14...@malasada.lava.net in gmane.comp.lang.haskell.cafe: his language also supports an interesting imperative primitive that lets you pick the first available value from a set of channels which isn't available in pure

RE: [Haskell-cafe] A small puzzle: inTwain as function of foldr

2009-06-05 Thread Brian Bloniarz
Hi all, Malcom Wallace wrote: Martijn van Steenbergen mart...@van.steenbergen.nl wrote: But this uses length and init and last all of which are recursive functions. I consider that cheating: only foldr may do the recursion. I think the key is to pick your intermediate data-structure

Re: [Haskell-cafe] Re: Pike's Newsqueak talk

2009-06-05 Thread Tim Newsham
Tim Newsham news...@lava.net wrote in article pine.bsi.4.64.0906051510070.14...@malasada.lava.net in gmane.comp.lang.haskell.cafe: his language also supports an interesting imperative primitive that lets you pick the first available value from a set of channels which isn't available in pure

[Haskell-cafe] Haddock : parse error on input `{-# UNPACK'

2009-06-05 Thread Erik de Castro Lopo
Hi all, I'm trying to compile the binary-strict module from hackage and I'm getting the exact same error as in the hackage build log: http://hackage.haskell.org/packages/archive/binary-strict/0.4.2/logs/failure/ghc-6.10 src/Data/Binary/Strict/IncrementalGet.hs:106:11: parse error on

Re: [Haskell-cafe] Pike's Newsqueak talk

2009-06-05 Thread Derek Elkins
On Fri, Jun 5, 2009 at 8:14 PM, Tim Newsham news...@lava.net wrote: I just watched http://video.google.com/videoplay?docid=810232012617965344 It's a great talk that is suprisingly relevant to Haskell programming (although at first blush it looks a bit unrelated). (It refs a lot of older work

[Haskell-cafe] nubBy seems broken in recent GHCs

2009-06-05 Thread Cale Gibbard
According to the Report: nubBy:: (a - a - Bool) - [a] - [a] nubBy eq [] = [] nubBy eq (x:xs) = x : nubBy eq (filter (\y - not (eq x y)) xs) Hence, we should have that nubBy () (1:2:[]) = 1 : nubBy () (filter (\y - not (1 y)) (2:[])) = 1 : nubBy () [] = 1 : [] However