From lambda.fairy at gmail.com Sat Nov 1 06:09:44 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Sat, 1 Nov 2014 19:09:44 +1300 Subject: [Haskell-cafe] <|> that short-circuits in IO ? In-Reply-To: References: <20141030134241.GA99529@inanna.trygub.com> <5452420A.2080803@ro-che.info> Message-ID: > With the latest transformers, I still get > > B > A > Right 42 > > i.e. the A hasn't been eliminated. > > What am I missing? Can you show us your code? Looking at the source: http://hackage.haskell.org/package/transformers-0.4.1.0/docs/src/Control-Monad-Trans-Except.html#line-169 http://hackage.haskell.org/package/transformers-0.4.1.0/docs/src/Control-Monad-Trans-Error.html#line-217 both ExceptT and ErrorT have short-circuiting <|> and mplus. Chris From konn.jinro at gmail.com Sat Nov 1 09:25:17 2014 From: konn.jinro at gmail.com (Hiromi ISHII) Date: Sat, 1 Nov 2014 18:25:17 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? Message-ID: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> Hi cafe, I'm currently implementing the data structure representing algebraic numbers. Implementing algebraic number arithmetic requires polynomial factorisation. Pure algorithm for factoring (Berlekamp's algorithm) is more expensive than the randomized one (Cantor-Zassenhaus algorithm) , so I want to use the latter algorithm. Since C-Z algorithm is a randomized algorithm, we have to have an access for random number generator when calculating algebraic number arithmetics e.g. writing Num instance for algebraic numbers. Here is the problem: how to pass-around random number generator throughout pure computaion? I think one immediate solution is to create global state with `newStdGen` and `unsafePerformIO` like below: ``` randSrc :: IORef StdGen randSrc = unsafePerformIO $ newIORef =<< newStdGen {-# NOINLINE randSrc #-} getRand :: IO Int getRand = atomicModifyIORef' randSrc (swap . next) -- We can probably use the following function to avoid calling -- `unsafePerformIO` whenever calling 'getRand`, -- assuming some optimization flag enabled: getRandUnsafe :: Int getRandUnsafe = unsafePerformIO getRand {-# NOINLINE getRandUnsafe #-} {-# RULES "getRandUnsafe" getRandUnsafe = unsafePerformIO getRand #-} ``` But this hack seems rather dirty and unsafe. Is there any workaround to achieve the same thing? -- Hiromi ISHII konn.jinro at gmail.com -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 496 bytes Desc: Message signed with OpenPGP using GPGMail URL: From spam at scientician.net Sat Nov 1 10:16:02 2014 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 01 Nov 2014 11:16:02 +0100 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> Message-ID: On 2014-11-01 10:25, Hiromi ISHII wrote: > Hi cafe, > > I'm currently implementing the data structure representing algebraic numbers. > > Implementing algebraic number arithmetic requires polynomial factorisation. > Pure algorithm for factoring (Berlekamp's algorithm) is more expensive than > the randomized one (Cantor-Zassenhaus algorithm) , so I want to use the > latter algorithm. > > Since C-Z algorithm is a randomized algorithm, we have to have an access > for random number generator when calculating algebraic number arithmetics > e.g. writing Num instance for algebraic numbers. > > Here is the problem: how to pass-around random number generator throughout pure computaion? > > I think one immediate solution is to create global state with `newStdGen` and `unsafePerformIO` like below: > You can just use the State monad to thread the StdGen around and "update" it when you need to. You can get a pure interface by hiding away the runState behind a function: -- The is the function you export from your module. myAlgorithm :: StdGen -> ... -> ... myAlgorithm g .... = fst . runState (myAlgorithm' ...) g myAlgorithm' :: ... -> State StdGen Result myAlgorithm' ... = do ... x <- rand ... return $ ... rand :: State StdGen a rand = do x <- get (a, g') <- random -- Here "random" is from System.Random put $! g' return a (The above probably contains typos, and can probably also be prettified, but hopefully you get the gist.) Regards, From konn.jinro at gmail.com Sat Nov 1 10:28:57 2014 From: konn.jinro at gmail.com (Hiromi ISHII) Date: Sat, 1 Nov 2014 19:28:57 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> Message-ID: <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> Hi Bardur, > You can just use the State monad to thread the StdGen around and > "update" it when you need to. You can get a pure interface by hiding > away the runState behind a function: Thank you for your rapid response! Unfortunately, I didn't describe my problem accurately. This approach (or using MonadRandom) to pass around random generator with Monad, works fine when it's just enough to feed generator to the algorithm. But my situation is slightly different: random generator has to be passed around to implement the instance method for `Num`, so it can't take random generator as its argument. So I need some way to hide random generator from function type signatures. Fortunately, your response suggested me the alternative approach: converting the data-type into continuation-passing style. This should work fine when we just do some operations on data-type, but we have to feed the generator when we want to inspect its value, so it's not sufficient, though... -- Hiromi ISHII konn.jinro at gmail.com -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 496 bytes Desc: Message signed with OpenPGP using GPGMail URL: From roma at ro-che.info Sat Nov 1 10:38:57 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sat, 01 Nov 2014 12:38:57 +0200 Subject: [Haskell-cafe] <|> that short-circuits in IO ? In-Reply-To: References: <20141030134241.GA99529@inanna.trygub.com> <5452420A.2080803@ro-che.info> Message-ID: <5454B841.8070506@ro-che.info> On 31/10/14 23:22, Kim-Ee Yeoh wrote: > On Thu, Oct 30, 2014 at 8:50 PM, Roman Cheplyaka wrote: > >>>> liftA2 (<|>) b a >>> >>> B >>> A >>> Right 42 >>> >>> (In the latter case I don't want A in the output?) >> >> Wrap it into ExceptT (from the latest transformers), as in >> >> runExceptT $ ExceptT a <|> ExceptT b > > > With the latest transformers, I still get > > B > A > Right 42 > > i.e. the A hasn't been eliminated. > > What am I missing? I don't know what you're missing, but when I run the following code, it doesn't print A. import Control.Monad.Except import Control.Applicative a = putStrLn "A" >> return (Left "hehe") b = putStrLn "B" >> return (Right 42) main = runExceptT $ ExceptT b <|> ExceptT a Roman From travis.cardwell at extellisys.com Sat Nov 1 11:59:43 2014 From: travis.cardwell at extellisys.com (Travis Cardwell) Date: Sat, 01 Nov 2014 20:59:43 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> Message-ID: <5454CB2F.50800@extellisys.com> Hi Ishii-san, ???????? On 2014?11?01? 18:25, Hiromi ISHII wrote: > Since C-Z algorithm is a randomized algorithm, we have to have an access > for random number generator when calculating algebraic number arithmetics > e.g. writing Num instance for algebraic numbers. > > Here is the problem: how to pass-around random number generator throughout pure computaion? > > I think one immediate solution is to create global state with `newStdGen` and `unsafePerformIO` like below: > But this hack seems rather dirty and unsafe. > > Is there any workaround to achieve the same thing? If it works with the algorithm, you could use a pseudo-random number generator with a fixed seed. For example, here is a program to estimate the value of ? (purely) using a Monte Carlo simulation: {-# LANGUAGE BangPatterns #-} module Main where import System.Random (mkStdGen, randomRs) -- | Estamate pi via monte-carlo simulation mcpi :: Int -- ^ number of iterations -> Double -- ^ estimated value of pi mcpi count = step (randomRs (0.0, 1.0) (mkStdGen 1331)) 0 count where step :: [Double] -> Int -> Int -> Double step (x:y:rs) !qrt !i | i < 1 = 4.0 * fromIntegral qrt / fromIntegral count | hit x y = step rs (qrt + 1) (i - 1) | otherwise = step rs qrt (i - 1) step _ _ _ = error "impossible" hit :: Double -> Double -> Bool hit x y = x ^ (2 :: Int) + y ^ (2 :: Int) <= 1.0 main :: IO () main = putStrLn $ "pi ~= " ++ show (mcpi 1000000) Cheers, Travis From jun.lambda at gmail.com Sat Nov 1 16:15:25 2014 From: jun.lambda at gmail.com (Jun Inoue) Date: Sat, 1 Nov 2014 17:15:25 +0100 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> Message-ID: Just an idea here, but would implicit-params work? It only gives you Reader-monad capabilities, but you can always split random generators. There might be repercussions for the quality of the generated numbers, though, for which I have no idea. {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} import Data.Implicit import System.Random import Text.Printf import Data.Default.Class instance Default StdGen where def = mkStdGen 10 newtype AlgebraicNumber = AlgebraicNumber {- your data here -} String deriving Show instance Implicit_ StdGen => Num AlgebraicNumber where AlgebraicNumber x + AlgebraicNumber y = -- You could tidy this up with a State monad. let g = param_ :: StdGen (g1, g2) = split g gx = fst $ next g1 -- compute on x using left generator gy = fst $ next g2 -- compute on y using right generator in AlgebraicNumber (printf ("%s computed with rand = %d," ++ "%s computed with rand = %d") x gx y gy) On Sat, Nov 1, 2014 at 11:28 AM, Hiromi ISHII wrote: > Hi Bardur, > >> You can just use the State monad to thread the StdGen around and >> "update" it when you need to. You can get a pure interface by hiding >> away the runState behind a function: > > Thank you for your rapid response! > Unfortunately, I didn't describe my problem accurately. > > This approach (or using MonadRandom) to pass around random generator with Monad, > works fine when it's just enough to feed generator to the algorithm. > > But my situation is slightly different: random generator has to be passed around to implement > the instance method for `Num`, so it can't take random generator as its argument. > So I need some way to hide random generator from function type signatures. > > Fortunately, your response suggested me the alternative approach: converting the data-type > into continuation-passing style. This should work fine when we just do some operations on > data-type, but we have to feed the generator when we want to inspect its value, so it's not > sufficient, though... > > -- Hiromi ISHII > konn.jinro at gmail.com > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Jun Inoue From michael at snoyman.com Sat Nov 1 16:50:52 2014 From: michael at snoyman.com (Michael Snoyman) Date: Sat, 1 Nov 2014 18:50:52 +0200 Subject: [Haskell-cafe] Debugging Wreq/http-client https requests In-Reply-To: References: Message-ID: We can certainly make this process more official/easier to use, but http-client does support this. Manager has a field mTlsConnection which specifies how to create a Connection value to a TLS server. Connection is a relatively simple datatype that specifies what to do, e.g., when sending data to a server. If you wanted to log all of that writes to a file, you might do something like: mOrig <- newManager tlsManagerSettings let m = mOrig { mTlsConnection = \ha h p -> do connOrig <- mTlsConnection mOrig ha h p return connOrig { connectionWrite = \bs -> do S.appendFile "/tmp/log" bs connectionWrite connOrig bs } } On Sat, Nov 1, 2014 at 1:16 AM, Cody Goodman wrote: > I have a program that is POST'ing some data to a remote server. > However, some part of the data I'm sending is wrong I believe. > > If this were plain http without encryption, wireshark would allow me > to see the exact data being sent over the wire. However, with https it > is encrypted. > > Is there an inbuilt way to debug requests sent by wreq or more likely, > a way to output debug info for http-client? > > Alternatively, is there a way to use NSS support with either of these > libraries: > > > http://security.stackexchange.com/questions/35639/decrypting-tls-in-wireshark-when-using-dhe-rsa-ciphersuites > > Thanks in advance to all for your time. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From konn.jinro at gmail.com Sun Nov 2 06:35:59 2014 From: konn.jinro at gmail.com (Hiromi ISHII) Date: Sun, 2 Nov 2014 15:35:59 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> Message-ID: Hi there, Thank you in advance for many people suggesting solution for this problem! On 2014/11/01 20:59, Travis Cardwell wrote: > If it works with the algorithm, you could use a pseudo-random number > generator with a fixed seed. For example, here is a program to estimate > the value of ? (purely) using a Monte Carlo simulation: I got it. But, in my case, fixing initial seed might cause inefficiency, so I can't take this way in this case. By the way, this approach seems works well for other cases which is not so quality sensitive. On 2014/11/02 1:02, Carter Schonwald wrote: > Hrm, you could make a num instance of a newtype wrapped state monad thats threading around your math! > > newtype MyNum = MN (State StdGen TheNumberType) This is almost the same as what I mean by "CPS-ing". We can omit generator argument by this approach, but we have to pass generator whenever we want to get the result or inspect the intermediate value. On 2014/11/02 1:15, Jun Inoue wrote: > Just an idea here, but would implicit-params work? It only gives you > Reader-monad capabilities, but you can always split random generators. > There might be repercussions for the quality of the generated numbers, > though, for which I have no idea. I think this is virtually the same as Travis's approach, because it returns same seed whenever we split the global value. And, yes, this causes repercussions for the random quality, and not suitable for my case. Perhaps we can parametrize `IORef StdGen` instead of `StdGen` so that we can change the state, but we have to call `unsafePerformIO` internally whenever accessing random generator, and then this appoarch became almost the same as my initial approach. By the way, we can control initial value with this implicit parameter approach, this might improve the random quality slightly than splitting global generator beforewards. -- Hiromi ISHII konn.jinro at gmail.com -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 496 bytes Desc: Message signed with OpenPGP using GPGMail URL: From travis.cardwell at extellisys.com Sun Nov 2 09:50:55 2014 From: travis.cardwell at extellisys.com (Travis Cardwell) Date: Sun, 02 Nov 2014 18:50:55 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> Message-ID: <5455FE7F.5000009@extellisys.com> Hi Ishii-san, On 2014?11?02? 15:35, Hiromi ISHII wrote: > I got it. But, in my case, fixing initial seed might cause > inefficiency, so I can't take this way in this case. > By the way, this approach seems works well for other cases which is > not so quality sensitive. Indeed: many algorithms merely require values from a uniform distribution, not necessarily random numbers. I was hopeful that Cantor-Zassenhaus would be one of them. Looking at your code [1], I see that you are exporting both `equalDegreeSplitM`, which uses `uniform` from `Control.Monad.Random`, and `equalDegreeFactorM`, which iteratively calls `equalDegreeSplitM`. One of the challenges of using a pure uniform stream is threading the state: since both functions are exported, implementation details would leak anyway. Great work, by the way! :) Travis [1] https://github.com/konn/computational-algebra/blob/master/Algebra/Ring/Polynomial/Factorize.hs From ky3 at atamo.com Sun Nov 2 14:01:38 2014 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Sun, 2 Nov 2014 21:01:38 +0700 Subject: [Haskell-cafe] <|> that short-circuits in IO ? In-Reply-To: <5454B841.8070506@ro-che.info> References: <20141030134241.GA99529@inanna.trygub.com> <5452420A.2080803@ro-che.info> <5454B841.8070506@ro-che.info> Message-ID: Chris, thank you for the links. I now understand ExceptT a lot better. Roman, thank you for the full program. What happened was I copy-pasted runExceptT $ ExceptT a <|> ExceptT b from your email into ghci. But you said the latest transformers was required, so I did the install. Finally, I saw an "A" printed out and went "Hey, that's not right!" Returning to the mail client, I referred back to Semen's original query and copy-pasted from there. But really it was A then B that I saw and not B then A. So mea culpa. Truth be told, all that while I was figuring out how to get Semen's "liftA2 (<|>)" to work and suffered cognitively from the lazy I/O solution I pursued. -- Kim-Ee From bertram.felgenhauer at googlemail.com Sun Nov 2 17:53:19 2014 From: bertram.felgenhauer at googlemail.com (Bertram Felgenhauer) Date: Sun, 2 Nov 2014 18:53:19 +0100 Subject: [Haskell-cafe] Fwd: Increasing Haskell modularity In-Reply-To: <54305253.4050807@gesh.uni.cx> References: <542BFE49.6020306@gesh.uni.cx> <20867A9D-0FCE-4CB2-8156-2232366F65E1@cis.upenn.edu> <542C0FFD.6070303@gesh.uni.cx> <542C75B9.2010303@gesh.uni.cx> <20141004065214.GA14453@24f89f8c-e6a1-4e75-85ee-bb8a3743bb9f> <54305253.4050807@gesh.uni.cx> Message-ID: <20141102175319.GA18147@24f89f8c-e6a1-4e75-85ee-bb8a3743bb9f> Sorry, I'm very late in returning to this thread, but maybe the answer is still of some interest. Gesh wrote: > On 10/4/2014 9:52 AM, Bertram Felgenhauer wrote: > >I think there are different possible interpretations of coherence in the > >absence of global uniqueness. To me, correctness of Data.Set (which your > >proposal would break) relies solely on coherence, on the fact that the > >comparisons in its various functions always go the same way for any two > >given values. Global or local uniqueness should not matter; after all, > >the locations of those comparisons do not change. (Actually, ghc falls > >short of this ideal, see [1].) Put differently, I view global uniqueness > >as an ingredient for ensuring coherence in the case that instance > >selection is deferred to the caller. > Please reread my definition of coherence. Admittedly, it is slightly > too concise, but the way I define coherence is that no matter how you > resolve constraints, the same instance is picked for each term. I had the impression that different people in this thread were using different interpretations of "coherence"; my aim was to point out this possible misunderstanding. > You seem to be defining coherence as meaning that no matter where a term > appears, then if the same type is inferred for it the same instance will > be picked. Right. This justifies inlining, for example. It also ensures that Data.Set as is is correct, without having to worry about different paths to the set implementation leading to different results. I find this very desirable. > I fail to see how this does not require global uniqueness of > instances, nor how the locations of the comparisons have anything to do > with it. I could have phrased that better. What I mean is that global uniqueness would not have to be stated explicitely, because, as you write, it's a consequence of the stronger interpretation of coherence. > > (let instance Ord Char where compare = flip (compare `on` ord) > > in 'a' < 'b' > > , 'a' < 'b') > > == (False, True) > the same instance will be chosen in both expressions - that is, > the local one in the first element and the global one in the second > - under any valid constraint resolver. > > >You seem to take the relaxed view that coherence is already satisfied if > >instance selection is deferred to the caller, even if different callers > >may select different instances for the same types. > If what you're saying is that in my opinion, the above code is > coherent, then I agree with your statement. What I mean is that you consider this code to be coherent: (.<.) :: Ord a => a -> a -> Bool x .<. y = x < y (by "deferred" instance selection I mean that the instance is provided by the caller) even though (let instance Ord Char where compare = flip (compare `on` ord) in 'a' .<. 'b' , 'a' .<. 'b') shows that for x = 'a' and y = 'b', different instances may be used for the 'a' < 'b' comparison in (.<.). This is, again, what breaks Data.Set. It also breaks specialization. And what about factoring out 'a' .<. 'b'? Overall I think global uniqueness is too useful to give up. Cheers, Bertram P.S. Kiselyov et al. discuss a restriction for local instances based on "opaque types" in Section 6.1. That looks like a good way for getting useful local instances (in particular for the configurations problem) without giving up global uniqueness. From corentin.dupont at gmail.com Sun Nov 2 22:12:24 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Sun, 2 Nov 2014 23:12:24 +0100 Subject: [Haskell-cafe] Nomyx (Beta 7): win 10000 Blings! Message-ID: Join us on Nomyx: www.nomyx.net It's a unique game where you can change the rules of the game, while playing it. Log in, and you'll understand better what the title means (check rule 44 proposed by me in the game)! Cheers, Corentin -------------- next part -------------- An HTML attachment was scrubbed... URL: From fuuzetsu at fuuzetsu.co.uk Mon Nov 3 02:05:44 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 03 Nov 2014 02:05:44 +0000 Subject: [Haskell-cafe] Nomyx (Beta 7): win 10000 Blings! In-Reply-To: References: Message-ID: <5456E2F8.5020809@fuuzetsu.co.uk> On 11/02/2014 10:12 PM, Corentin Dupont wrote: > Join us on Nomyx: www.nomyx.net > It's a unique game where you can change the rules of the game, while > playing it. > Log in, and you'll understand better what the title means (check rule 44 > proposed by me in the game)! > > Cheers, > Corentin > You should say Nomyx is inspired by Haskell in your e-mail or something, I had to do a double-take on ?is this spam?? even though I already heard of Nomyx and even looked through the site a bit before. -- Mateusz K. From trupill at gmail.com Mon Nov 3 08:07:48 2014 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Mon, 3 Nov 2014 09:07:48 +0100 Subject: [Haskell-cafe] Pattern variables in Template Haskell Message-ID: Dear Haskell-cafe, I'm trying to use Template Haskell to generate patterns in Haskell code, but after a couple of days of trying, I have not come with a solution. I hope somebody could help me. My problem is basically that I want something like: example :: Maybe a -> a example $(j "x") = x to work correctly. The idea of this simple quoter is to generate code similar to: example :: Maybe a -> a example (Just x_123) = x_123 that is, to create the "Just" pattern, and to make "x" bind to the same element. Right now my code reads: j :: String -> Q Pat j s = return (ConP 'Just [VarP (mkName s)]) which generated a new variable "x" each time, thus unable to match with the "x" in the RHS. I have also tried with lookupValueName. Note that my problem is a bit more complicated, with variable names coming from a different source. However, I think that if I solve this problem where I can make variables in a pattern and in an expression match, I should be able to use them in my complete solution. Thanks in advance. -------------- next part -------------- An HTML attachment was scrubbed... URL: From rikvdkleij at gmail.com Mon Nov 3 08:57:37 2014 From: rikvdkleij at gmail.com (Rik van der Kleij) Date: Mon, 3 Nov 2014 00:57:37 -0800 (PST) Subject: [Haskell-cafe] ANN: Released new version of Haskell plugin for IntelliJ Message-ID: Hi everyone, I'm glad to announce version 0.2. It's available in Jetbrains plugin repository. Besides improvements and minor changes, version 0.2 has support for HLint inspection and quick fixes based on HLint suggestions. For more information, see change notes. Complete feature list is now: - Syntax highlighting (which can be customized); - Error/warning highlighting; - Find Usages of identifiers; - Resolving references of identifiers (also to library code if library source code is added to project and resolves inside import declaration); - Code completion by resolving references; - Renaming variables (which first shows preview so refactoring scope can be adjusted); - View type info from (selected) expression; - View expression info; - View quick documentation; - View quick definition; - Structure view; - Navigate to declaration (called `Class` in IntelliJ menu); - Navigate to identifier (called `Symbol` in IntelliJ menu); - Code completion by looking to import declarations; - Simple form of code formatting; - Inspection by HLint; - Quick fixes for HLint suggestions; - View error, action to view formatted message from ghc-mod. Especially useful in case message consists of multiple lines (Ctrl-F10, Meta-F10 on Mac OSX); See for more information and getting started: https://github.com/rikvdkleij/intellij-haskell Any feedback is welcome! Regards, Rik -------------- next part -------------- An HTML attachment was scrubbed... URL: From tomas.carnecky at gmail.com Mon Nov 3 10:09:29 2014 From: tomas.carnecky at gmail.com (Tomas Carnecky) Date: Mon, 3 Nov 2014 11:09:29 +0100 Subject: [Haskell-cafe] Debugging Wreq/http-client https requests In-Reply-To: References: Message-ID: You can use mitmproxy with a self-generated certificate. That will work even if you can't control the URL where the app sends the requests to, simply add the hostname to your /etc/hosts and point it to 127.0.0.1. On Sat, Nov 1, 2014 at 12:16 AM, Cody Goodman wrote: > I have a program that is POST'ing some data to a remote server. > However, some part of the data I'm sending is wrong I believe. > > If this were plain http without encryption, wireshark would allow me > to see the exact data being sent over the wire. However, with https it > is encrypted. > > Is there an inbuilt way to debug requests sent by wreq or more likely, > a way to output debug info for http-client? > > Alternatively, is there a way to use NSS support with either of these libraries: > > http://security.stackexchange.com/questions/35639/decrypting-tls-in-wireshark-when-using-dhe-rsa-ciphersuites > > Thanks in advance to all for your time. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From corentin.dupont at gmail.com Mon Nov 3 12:41:51 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Mon, 3 Nov 2014 13:41:51 +0100 Subject: [Haskell-cafe] Nomyx (Beta 7): win 10000 Blings! In-Reply-To: <5456E2F8.5020809@fuuzetsu.co.uk> References: <5456E2F8.5020809@fuuzetsu.co.uk> Message-ID: That right, sorry for the title which is a bit cheesy. The current game is developing well (new rules about spaceships just been posted), but we need more players to keep it alive :) This is an interesting social experience in Haskell. You can think of it as a sort Minecraft (build a world collectively) in Haskell :) I'm interested to know how we can make it more accessible and easy to play, while keeping the spirit of it! On Mon, Nov 3, 2014 at 3:05 AM, Mateusz Kowalczyk wrote: > On 11/02/2014 10:12 PM, Corentin Dupont wrote: > > Join us on Nomyx: www.nomyx.net > > It's a unique game where you can change the rules of the game, while > > playing it. > > Log in, and you'll understand better what the title means (check rule 44 > > proposed by me in the game)! > > > > Cheers, > > Corentin > > > > You should say Nomyx is inspired by Haskell in your e-mail or something, > I had to do a double-take on ?is this spam?? even though I already heard > of Nomyx and even looked through the site a bit before. > > -- > Mateusz K. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Mon Nov 3 14:53:21 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Mon, 3 Nov 2014 09:53:21 -0500 Subject: [Haskell-cafe] Pattern variables in Template Haskell In-Reply-To: References: Message-ID: I just tried > foo $( [p| x |] ) = x and got that x is unbound on the RHS. This may be a GHC bug if no one here knows how this is supposed to work. I sure don't, but I've never explored pattern splices. Richard On Nov 3, 2014, at 3:07 AM, Alejandro Serrano Mena wrote: > Dear Haskell-cafe, > I'm trying to use Template Haskell to generate patterns in Haskell code, but after a couple of days of trying, I have not come with a solution. I hope somebody could help me. > > My problem is basically that I want something like: > > example :: Maybe a -> a > example $(j "x") = x > > to work correctly. The idea of this simple quoter is to generate code similar to: > > example :: Maybe a -> a > example (Just x_123) = x_123 > > that is, to create the "Just" pattern, and to make "x" bind to the same element. Right now my code reads: > > j :: String -> Q Pat > j s = return (ConP 'Just [VarP (mkName s)]) > > which generated a new variable "x" each time, thus unable to match with the "x" in the RHS. I have also tried with lookupValueName. > > Note that my problem is a bit more complicated, with variable names coming from a different source. However, I think that if I solve this problem where I can make variables in a pattern and in an expression match, I should be able to use them in my complete solution. > > Thanks in advance. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From trupill at gmail.com Mon Nov 3 15:27:25 2014 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Mon, 3 Nov 2014 16:27:25 +0100 Subject: [Haskell-cafe] Pattern variables in Template Haskell In-Reply-To: References: Message-ID: I found some old docs saying that pattern splices are not completely implemented due to this problem with binding. At the end, I used quasi-quotation + haskell-src-exts to achieve the same results. In this case, it seemed to work because quasi-quoters are run before the renamer, instead of after it. In any case, thanks very much for your help :) 2014-11-03 15:53 GMT+01:00 Richard Eisenberg : > I just tried > > > foo $( [p| x |] ) = x > > and got that x is unbound on the RHS. This may be a GHC bug if no one here > knows how this is supposed to work. I sure don't, but I've never explored > pattern splices. > > Richard > > On Nov 3, 2014, at 3:07 AM, Alejandro Serrano Mena > wrote: > > > Dear Haskell-cafe, > > I'm trying to use Template Haskell to generate patterns in Haskell code, > but after a couple of days of trying, I have not come with a solution. I > hope somebody could help me. > > > > My problem is basically that I want something like: > > > > example :: Maybe a -> a > > example $(j "x") = x > > > > to work correctly. The idea of this simple quoter is to generate code > similar to: > > > > example :: Maybe a -> a > > example (Just x_123) = x_123 > > > > that is, to create the "Just" pattern, and to make "x" bind to the same > element. Right now my code reads: > > > > j :: String -> Q Pat > > j s = return (ConP 'Just [VarP (mkName s)]) > > > > which generated a new variable "x" each time, thus unable to match with > the "x" in the RHS. I have also tried with lookupValueName. > > > > Note that my problem is a bit more complicated, with variable names > coming from a different source. However, I think that if I solve this > problem where I can make variables in a pattern and in an expression match, > I should be able to use them in my complete solution. > > > > Thanks in advance. > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From f at mazzo.li Mon Nov 3 15:29:47 2014 From: f at mazzo.li (Francesco Mazzoli) Date: Mon, 3 Nov 2014 16:29:47 +0100 Subject: [Haskell-cafe] Travis builds failing with spurious errors Message-ID: Hi all, Apologies if this is not the right space to ask this question. We set up CI for Agda with Travis: . The problem is that we're having trouble with older versions of GHC. For example, with GHC 7.4.2, the build complains that ScopedTypeVariables is not enabled, even if it is. You can check the build failure here: , and the relevant file here: . As you can see from the pragmas ScopedTypeVariables is enabled, and in fact when building locally I have no problems. We also got some spurious messages regarding syntax. Has anybody encountered similar problems? I don't know if it's something depending on Travis or some configuration mistakes, but I'm a bit at loss on how to research this. Moving the OPTIONS_GHC pragma after the LANGUAGE pragmas seems to fix the issue but I'd like to know what's going on. Thanks, Francesco From mgajda at mimuw.edu.pl Mon Nov 3 16:59:14 2014 From: mgajda at mimuw.edu.pl (Michal J Gajda) Date: Tue, 4 Nov 2014 00:59:14 +0800 Subject: [Haskell-cafe] [ANN]json-autotype: Tool generating JSON parsers and type declarations from example documents... Message-ID: Dear Fellow Haskellers, I've just published a beta version of a tool facilitating generation of Haskell type declarations from example JSON documents. It is supposed to simplify implementing large JSON-based interfaces, without necessity of writing any boilerplate code. USAGE: ====== After installing with `cabal install json-autotype`, you might generate stub code for the parser: $ json-autotype input.json -o MyFormat.hs Then you might test the parser by running it on an input file: $ runghc MyFormat.hs input.json If everything is correct, then feel free to inspect the data structure generated automatically for you! The goal of this program is to make it easy for users of big JSON APIs to generate entries from example data. Occasionally you might find a valid JSON for which `json-autotype` doesn't generate a correct parser. You may either edit the resulting file _and_ send it to the author as a test case for future release. HOW IT WORKS: ============== The program uses union type unification to trim output declarations. The types of same attribute tag and similar attribute set, are automatically unified using recognition by attribute set matching. (This option can be optionally turned off, or a set of unified types may be given explicitly.) Either alternatives is used to assure that all JSON inputs seen in example input file are handled correctly. Details on official releases are on Hackage [1] 1. https://hackage.haskell.org/package/json-autotype Patches and suggestions are most welcome. -- Best regards Micha? J. Gajda -------------- next part -------------- An HTML attachment was scrubbed... URL: From sean at functionaljobs.com Mon Nov 3 17:00:01 2014 From: sean at functionaljobs.com (Functional Jobs) Date: Mon, 3 Nov 2014 12:00:01 -0500 Subject: [Haskell-cafe] New Functional Programming Job Opportunities Message-ID: <5457b4946035b@functionaljobs.com> Here are some functional programming job opportunities that were posted recently: Senior Software Engineer at Soda Software Labs http://functionaljobs.com/jobs/8758-senior-software-engineer-at-soda-software-labs Cheers, Sean Murphy FunctionalJobs.com From roma at ro-che.info Mon Nov 3 21:35:44 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Mon, 03 Nov 2014 23:35:44 +0200 Subject: [Haskell-cafe] [ANN]json-autotype: Tool generating JSON parsers and type declarations from example documents... In-Reply-To: References: Message-ID: <5457F530.1050306@ro-che.info> Hi Michal, Sounds interesting. Can you show (and include in the README) some examples of recognized json inputs and code generated for them? On 03/11/14 18:59, Michal J Gajda wrote: > Dear Fellow Haskellers, > > I've just published a beta version of a tool facilitating generation of > Haskell type declarations from example JSON documents. It is supposed to > simplify implementing large JSON-based interfaces, without necessity of > writing any boilerplate code. > > USAGE: > ====== > After installing with `cabal install json-autotype`, you might generate > stub code for the parser: > > $ json-autotype input.json -o MyFormat.hs > > Then you might test the parser by running it on an input file: > > $ runghc MyFormat.hs input.json > > If everything is correct, then feel free to inspect the data structure > generated automatically for you! > The goal of this program is to make it easy for users of big JSON APIs to > generate entries from > example data. > > Occasionally you might find a valid JSON for which `json-autotype` doesn't > generate a correct parser. > You may either edit the resulting file _and_ send it to the author as a > test case for future release. > > HOW IT WORKS: > ============== > The program uses union type unification to trim output declarations. The > types of same attribute tag and similar attribute set, are automatically > unified using recognition by attribute set matching. (This option can be > optionally turned off, or a set of unified types may be given explicitly.) > Either alternatives is used to assure that all JSON inputs seen in example > input file are handled correctly. > > Details on official releases are on Hackage [1] > > 1. https://hackage.haskell.org/package/json-autotype > > Patches and suggestions are most welcome. > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From bneijt at gmail.com Mon Nov 3 21:49:03 2014 From: bneijt at gmail.com (Bram Neijt) Date: Mon, 3 Nov 2014 22:49:03 +0100 Subject: [Haskell-cafe] Code review request: Library and executable to read USB temperature device Message-ID: Dear reader, I have written a small executable and library to read values from a USB device and would like someone with more knowledge then hlint to review my code. If you find the time to read https://github.com/bneijt/temper/blob/master/src/lib/Temper.hs please consider placing comments/issues on Github or mailing the list or me directly with your comments. I also have the following doubts about the code: - It has some bit-shifting code on line 18 to 20. Is there a nicer "unpack two bytes to an integer" method? - I'm using test-framework with test-framework-hunit but it feels clunky, is hspec a more common approach to testing? - I'm ignoring a lot of return values between lines 61 to 70. In a language like Python or Java I would add assert statements or checks with exceptions there. How should I go about that in Haskell? Greetings, Bram From jeffbrown.the at gmail.com Mon Nov 3 22:53:11 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Mon, 3 Nov 2014 14:53:11 -0800 Subject: [Haskell-cafe] Obscure, important concepts Message-ID: What concepts relatively unique to Haskell are powerful, widely applicable, and not mentioned in most introductory texts? (By "relatively unique to Haskell" I mean maybe they're part of Lisp or Scheme, but not, say, Java.) Some of the concepts important to Haskell, such as lambda expressions and recursion, are also present in more popular languages. Many others, though, either have no equivalent in (most) other languages, or else are very unlike the equivalent: types, classes and kinds higher-order functions evaluation partial application tail recursion laziness currying pattern matching application and composition operations contexts functors, applicatives, monads monad transformers * lenses* * :def macros* * arrows* * continuation passing style* * software transactional memory* Most of those topics appear to be covered by introductory texts, but the last five are not. I found each of them by accident, and each kind of blew my mind. They all strike me as powerful, widely applicable, and obscure. Are there others? -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Mon Nov 3 23:11:23 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Mon, 3 Nov 2014 17:11:23 -0600 Subject: [Haskell-cafe] Obscure, important concepts In-Reply-To: References: Message-ID: Arguably http://chimera.labs.oreilly.com/books/1230000000929 by Simon Marlow is pretty authoritative on concurrency and parallelism in Haskell. As a nice bonus, it contains one of the best explanations of weak-head normal form and laziness in Haskell. For lenses, Joseph Abrahamson has made some excellent tutorials on his codewars account: http://www.codewars.com/users/tel/authored The exercises take you through inventing lenses from scratch. Learning `lens` specifically entails learning contravariant, profunctors, choice, traversals, etc. It's not that bad understanding `lens` once you have a facility for algebras-as-typeclasses and have an idea of the end-goal by having played with and built lenses independently. To see some older forms of lenses, consider googling "semantic editor combinator". The nomenclature is suggestive. Macros - basically anything about quasiquoting or TH. I point people in the same direction here as I do with Generics. Look at example applications and uses, then write your own. Being comfortable with folding/reducing ASTs will help a lot here. You could use Aeson's TH module as a place to start with this. Continuation passing style - learning how "Cont" works is a good place to start with CPS in Haskell. It's intimidating but not particularly complicated?subtle in ways that can defeat learners. I'm not much of an expert on Arrows. I feel people that have used them more (such as in arrowized FRP) might be more helpful here. I had use for `first` recently but I only used it because the Bifunctor wasn't available. I feel I might be stating something self-evident, but Arrows can be nice if you're kicking around a lot of stuff that's * -> * -> * and you want to address the types therein and not partially apply them out of scope from the interface. Example: Bifunctor is * -> * -> * whereas Functor is kind * -> *. This lets me choose to map over the "Left" or the "Right" constructors of an Either, rather than only mapping over the "Right" as in the case of the Functor. I stash resources and useful links in my guide here: https://github.com/bitemyapp/learnhaskell Hope this helps. --- Chris Allen On Mon, Nov 3, 2014 at 4:53 PM, Jeffrey Brown wrote: > What concepts relatively unique to Haskell are powerful, widely > applicable, and not mentioned in most introductory texts? (By "relatively > unique to Haskell" I mean maybe they're part of Lisp or Scheme, but not, > say, Java.) > > Some of the concepts important to Haskell, such as lambda expressions and > recursion, are also present in more popular languages. Many others, though, > either have no equivalent in (most) other languages, or else are very > unlike the equivalent: > > types, classes and kinds > higher-order functions > evaluation > partial application > tail recursion > laziness > currying > pattern matching > application and composition operations > contexts > functors, applicatives, monads > monad transformers > * lenses* > * :def macros* > * arrows* > * continuation passing style* > * software transactional memory* > > Most of those topics appear to be covered by introductory texts, but the > last five are not. I found each of them by accident, and each kind of blew > my mind. They all strike me as powerful, widely applicable, and obscure. > > Are there others? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From cpdurham at gmail.com Tue Nov 4 00:20:10 2014 From: cpdurham at gmail.com (Charles Durham) Date: Mon, 3 Nov 2014 19:20:10 -0500 Subject: [Haskell-cafe] Inlinable vs inline Message-ID: Hi, I wanted to get some clarifications on how inlinable and inline behave. One particular case is where you have a module exporting some functions with helper functions that are not exported. You go ahead and add inlinable to the exported functions so that the call site can specialize on them. Is there any penalty to adding inline vs inlinable to the helper functions? For example, are there cases where a helper function will not inline and thus can not be specailized at the call site and it would be better to declare the helper function inlinable? I would be interested to hear any nuances related to the differences and practical consequences of these pragmas. Thanks! Charlie Durham -------------- next part -------------- An HTML attachment was scrubbed... URL: From mgajda at mimuw.edu.pl Tue Nov 4 01:13:01 2014 From: mgajda at mimuw.edu.pl (Michal J Gajda) Date: Tue, 4 Nov 2014 09:13:01 +0800 Subject: [Haskell-cafe] [ANN]json-autotype: Tool generating JSON parsers and type declarations from example documents... In-Reply-To: <5457F530.1050306@ro-che.info> References: <5457F530.1050306@ro-che.info> Message-ID: Hi Roman, fellow Haskellers, On 04/11/2014 05:35, Roman Cheplyaka wrote: Sounds interesting. Can you show (and include in the README) some examples of recognized json inputs and code generated for them? There are rather extensive examples provides as unit tests in the source code repository, which I do not distribute with the package, since they may be covered by copyright of whatever APIs they were produced with (like Twitter, YouTube, Jenkins etc.). Thanks for pointing out that there should be some examples provided along the package! The most simple example: { "colorsArray":[{ "colorName":"red", "hexValue":"#f00" }, { "colorName":"green", "hexValue":"#0f0" }, { "colorName":"blue", "hexValue":"#00f" } ] } It will produce the module with the following datatypes and TH calls for JSON parser derivations: data ColorsArray = ColorsArray { colorsArrayHexValue :: Text, colorsArrayColorName :: Text } deriving (Show,Eq) data TopLevel = TopLevel { topLevelColorsArray :: ColorsArray } deriving (Show,Eq) Note that attribute names match the names of JSON dictionary keys. Another example with ambiguous types: { "parameter":[{ "parameterName":"apiVersion", "parameterValue":1 }, { "parameterName":"failOnWarnings", "parameterValue":false }, { "parameterName":"caller", "parameterValue":"site API" }] } It will produce quite intuitive result (plus extra parentheses, and class derivations): data Parameter = Parameter { parameterParameterValue :: Either Bool (Either Int Text), parameterParameterName :: Text } data TopLevel = TopLevel { topLevelParameter :: Parameter } I will add these examples to the README. For real world use cases you might look at the current unit test directory. All of .json files there generate the correct parsers: https://github.com/mgajda/json-autotype/tree/master/test -- Best regards Michal On 03/11/14 18:59, Michal J Gajda wrote: Dear Fellow Haskellers, I've just published a beta version of a tool facilitating generation of Haskell type declarations from example JSON documents. It is supposed to simplify implementing large JSON-based interfaces, without necessity of writing any boilerplate code. USAGE: ====== After installing with `cabal install json-autotype`, you might generate stub code for the parser: $ json-autotype input.json -o MyFormat.hs Then you might test the parser by running it on an input file: $ runghc MyFormat.hs input.json If everything is correct, then feel free to inspect the data structure generated automatically for you! The goal of this program is to make it easy for users of big JSON APIs to generate entries from example data. Occasionally you might find a valid JSON for which `json-autotype` doesn't generate a correct parser. You may either edit the resulting file _and_ send it to the author as a test case for future release. HOW IT WORKS: ============== The program uses union type unification to trim output declarations. The types of same attribute tag and similar attribute set, are automatically unified using recognition by attribute set matching. (This option can be optionally turned off, or a set of unified types may be given explicitly.) Either alternatives is used to assure that all JSON inputs seen in example input file are handled correctly. Details on official releases are on Hackage [1] 1. https://hackage.haskell.org/package/json-autotype Patches and suggestions are most welcome. _______________________________________________ Haskell-Cafe mailing listHaskell-Cafe at haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Tue Nov 4 03:02:21 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Mon, 3 Nov 2014 19:02:21 -0800 Subject: [Haskell-cafe] Monads and scope Message-ID: *Question 1: Are monad stacks "transparent" -- that is, can one use a layer in the middle of a monad stack without thinking about other layers?* In learning about how to stack multiple monads (or more literally, how to stack monad transformers on top of a monad), I was expecting that in order to reach into the middle of the stack, one would have to stay aware of the order in which the stack was created, and unwrap outer transformers to get there. That appears to be false. For instance, the program UglyStack.hs in Chapter 18 (Monad Transformers) of Real World Haskell includes a function called "constrainedCount" that, in a ReaderT (StateT IO) stack, calls "ask", "get" and some IO functions as if no layer of the stack interferes with any of the others. Is that true in general? That is, if I build on top of a monad M a stack of monad transformers T1 T2 T3 ... TN M, and each of the Tn have different functions associated with them, call I call those functions without even remembering the order in which the transformers were stacked? Does the order of the stack constrain the programmer in how they chain execution functions like runReader, but not otherwise? *Question 2: Does a monad's scope extend maximally upward through the call stack?* All the programs I have seen that use monads keep them at the top scope: The "main" function will use them, and perhaps functions it calls, but if one descends low enough into the call stack, one escapes from the monad context into pure functional code. Can one ever escape a monad in the reverse direction? Stated differently: Monadic code can call pure code. Can pure code ever call monadic code? -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Tue Nov 4 03:15:20 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 3 Nov 2014 22:15:20 -0500 Subject: [Haskell-cafe] Monads and scope In-Reply-To: References: Message-ID: On Mon, Nov 3, 2014 at 10:02 PM, Jeffrey Brown wrote: > *Question 1: Are monad stacks "transparent" -- that is, can one use a > layer in the middle of a monad stack without thinking about other layers?* > > In learning about how to stack multiple monads (or more literally, how to > stack monad transformers on top of a monad), I was expecting that in order > to reach into the middle of the stack, one would have to stay aware of the > order in which the stack was created, and unwrap outer transformers to get > there. > If you're doing it manually, yes, that would be true. Newtype deriving can be used to hide it, assuming that the levels are distinct enough: you can't easily pick between two MonadReader-s, for example, without lifting past one of them (and therefore having to at least know what order they are in). Is that true in general? That is, if I build on top of a monad M a stack of > monad transformers T1 T2 T3 ... TN M, and each of the Tn have different > functions associated with them, call I call those functions without even > remembering the order in which the transformers were stacked? Does the > order of the stack constrain the programmer in how they chain execution > functions like runReader, but not otherwise? > If you use newtype deriving, you can mostly avoid depth or ordering. One remaining sticky case is that of `fail`; if a monad in the middle calls `fail`, state below that monad *may* be lost. (But `fail` is rather badly behaved in general, and is best avoided.) Stated differently: Monadic code can call pure code. Can pure code ever > call monadic code? > Something like runReaderT or runST? Or in the extreme case, unsafePerformIO --- which is unsafe for a reason, and trying to use it to sneak into IO from pure code will usually cause major problems, because pure code does not expect non-deterministic results. Otherwise, the type system does its best to avoid you unexpectedly dipping into e.g. IO from inside pure code. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From fuuzetsu at fuuzetsu.co.uk Tue Nov 4 03:56:52 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Tue, 04 Nov 2014 03:56:52 +0000 Subject: [Haskell-cafe] Monads and scope In-Reply-To: References: Message-ID: <54584E84.1020705@fuuzetsu.co.uk> On 11/04/2014 03:02 AM, Jeffrey Brown wrote: > *Question 1: Are monad stacks "transparent" -- that is, can one use a layer > in the middle of a monad stack without thinking about other layers?* > > In learning about how to stack multiple monads (or more literally, how to > stack monad transformers on top of a monad), I was expecting that in order > to reach into the middle of the stack, one would have to stay aware of the > order in which the stack was created, and unwrap outer transformers to get > there. > > That appears to be false. For instance, the program UglyStack.hs in Chapter > 18 (Monad Transformers) of Real World Haskell > includes a > function called "constrainedCount" that, in a ReaderT (StateT IO) stack, > calls "ask", "get" and some IO functions as if no layer of the stack > interferes with any of the others. Each of these functions works thanks to typeclasses: someone made the Monad in question an instance of all those typeclasses so that you could use these functions as if they were all on the same layer. In reality the lifting is done at instance declarations. > Is that true in general? That is, if I build on top of a monad M a stack of > monad transformers T1 T2 T3 ... TN M, and each of the Tn have different > functions associated with them, call I call those functions without even > remembering the order in which the transformers were stacked? Does the > order of the stack constrain the programmer in how they chain execution > functions like runReader, but not otherwise? It definitely matters how you stack your transformer especially when it comes to unwrapping it: did you want a ?Maybe (IO a)? or ?IO (Maybe a)?? This is a bit of a silly example but hopefully you get the idea that the ordering can't be randomly scrambled around without thought. > > *Question 2: Does a monad's scope extend maximally upward through the call > stack?* > > All the programs I have seen that use monads keep them at the top scope: > The "main" function will use them, and perhaps functions it calls, but if > one descends low enough into the call stack, one escapes from the monad > context into pure functional code. Can one ever escape a monad in the > reverse direction? > > Stated differently: Monadic code can call pure code. Can pure code ever > call monadic code? > > This whole question just doesn't make sense to me at all. First of all, monadic code (whatever that is meant to mean) is pure. From this alone the question is meaningless. If I wrap something in Identity is it now not pure somehow? Did you know that ((->) a) also forms a Monad? Are functions now not pure code? There is no difference between ?monadic code? and ?pure code?, they are the same thing, it's just that the former is dressed up into a form that's convenient to work with. So you'll have to give a clearer definition of ?pure? and ?monadic? code here and show that they are somehow distinct in order to even have hope to asking such a thing. I suspect you can not ;). -- Mateusz K. From fuuzetsu at fuuzetsu.co.uk Tue Nov 4 04:01:26 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Tue, 04 Nov 2014 04:01:26 +0000 Subject: [Haskell-cafe] [ANN]json-autotype: Tool generating JSON parsers and type declarations from example documents... In-Reply-To: References: <5457F530.1050306@ro-che.info> Message-ID: <54584F96.2000800@fuuzetsu.co.uk> On 11/04/2014 01:13 AM, Michal J Gajda wrote: > Hi Roman, fellow Haskellers, > > On 04/11/2014 05:35, Roman Cheplyaka wrote: > > Sounds interesting. Can you show (and include in the README) some > examples of recognized json inputs and code generated for them? > > There are rather extensive examples provides as unit tests in the source > code repository, which I do not distribute with the package, since they may > be covered by copyright of whatever APIs they were produced with (like > Twitter, YouTube, Jenkins etc.). Thanks for pointing out that there should > be some examples provided along the package! > > The most simple example: > { > "colorsArray":[{ > "colorName":"red", > "hexValue":"#f00" > }, > { > "colorName":"green", > "hexValue":"#0f0" > }, > { > "colorName":"blue", > "hexValue":"#00f" > } > ] > } > > It will produce the module with the following datatypes and TH calls for > JSON parser derivations: > data ColorsArray = ColorsArray { > colorsArrayHexValue :: Text, > colorsArrayColorName :: Text > } deriving (Show,Eq) > > data TopLevel = TopLevel { > topLevelColorsArray :: ColorsArray > } deriving (Show,Eq) > > Note that attribute names match the names of JSON dictionary keys. > > Another example with ambiguous types: > { > "parameter":[{ > "parameterName":"apiVersion", > "parameterValue":1 > }, > { > "parameterName":"failOnWarnings", > "parameterValue":false > }, > { > "parameterName":"caller", > "parameterValue":"site API" > }] > } > > It will produce quite intuitive result (plus extra parentheses, and class > derivations): > > data Parameter = Parameter { > parameterParameterValue :: Either Bool (Either Int Text), > parameterParameterName :: Text > } > > data TopLevel = TopLevel { > topLevelParameter :: Parameter > } > > I will add these examples to the README. > > For real world use cases you might look at the current unit test directory. > All of .json files there generate the correct parsers: > https://github.com/mgajda/json-autotype/tree/master/test > -- > Best regards > Michal > I imagine unpacking N layers of ?Either? would get really boring really fast. Did you consider rolling your own sum types once it gets past certain depth? I think even doubly nested Either is already getting inconvenient. -- Mateusz K. From mwm at mired.org Tue Nov 4 04:08:30 2014 From: mwm at mired.org (Mike Meyer) Date: Mon, 3 Nov 2014 22:08:30 -0600 Subject: [Haskell-cafe] Monads and scope In-Reply-To: References: Message-ID: On Nov 3, 2014 9:15 PM, "Brandon Allbery" wrote > On Mon, Nov 3, 2014 at 10:02 PM, Jeffrey Brown wrote: >> Stated differently: Monadic code can call pure code. Can pure code ever call monadic code? > Something like runReaderT or runST? Or in the extreme case, unsafePerformIO --- which is unsafe for a reason, and trying to use it to sneak into IO from pure code will usually cause major problems, because pure code does not expect non-deterministic results. Otherwise, the type system does its best to avoid you unexpectedly dipping into e.g. IO from inside pure code. To be more general, the monad typeclass doesn't include an operation that returns a value that doesn't have the type of the monad, so the answer in general is no. Specific instances of the typeclass can have such operations. Brandon gave some examples of those. -------------- next part -------------- An HTML attachment was scrubbed... URL: From trupill at gmail.com Tue Nov 4 07:42:49 2014 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Tue, 4 Nov 2014 08:42:49 +0100 Subject: [Haskell-cafe] Obscure, important concepts In-Reply-To: References: Message-ID: Lenses and software transactional memory are covered in my book "Beginning Haskell" http://www.apress.com/9781430262503 To the list of things that blew my mind, I would like to add data type generic programming (in the style of GHC.Generics), something which is really useful but not that discussed. 2014-11-03 23:53 GMT+01:00 Jeffrey Brown : > What concepts relatively unique to Haskell are powerful, widely > applicable, and not mentioned in most introductory texts? (By "relatively > unique to Haskell" I mean maybe they're part of Lisp or Scheme, but not, > say, Java.) > > Some of the concepts important to Haskell, such as lambda expressions and > recursion, are also present in more popular languages. Many others, though, > either have no equivalent in (most) other languages, or else are very > unlike the equivalent: > > types, classes and kinds > higher-order functions > evaluation > partial application > tail recursion > laziness > currying > pattern matching > application and composition operations > contexts > functors, applicatives, monads > monad transformers > * lenses* > * :def macros* > * arrows* > * continuation passing style* > * software transactional memory* > > Most of those topics appear to be covered by introductory texts, but the > last five are not. I found each of them by accident, and each kind of blew > my mind. They all strike me as powerful, widely applicable, and obscure. > > Are there others? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 4 08:30:18 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 4 Nov 2014 08:30:18 +0000 Subject: [Haskell-cafe] Why does this work: 'instance Num (Show a) where' Message-ID: <20141104083017.GA15492@weber> This is accepted by GHC 7.6.3. Is this a bug? What does it mean? instance Num (Show a) where From konn.jinro at gmail.com Tue Nov 4 08:53:57 2014 From: konn.jinro at gmail.com (Hiromi ISHII) Date: Tue, 4 Nov 2014 17:53:57 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <5455FE7F.5000009@extellisys.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> <5455FE7F.5000009@extellisys.com> Message-ID: <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> Hi, On 2014/11/02 18:50, Travis Cardwell wrote: > Indeed: many algorithms merely require values from a uniform distribution, > not necessarily random numbers. I was hopeful that Cantor-Zassenhaus > would be one of them. > > Looking at your code [1], I see that you are exporting both > `equalDegreeSplitM`, which uses `uniform` from `Control.Monad.Random`, and > `equalDegreeFactorM`, which iteratively calls `equalDegreeSplitM`. One of > the challenges of using a pure uniform stream is threading the state: > since both functions are exported, implementation details would leak anyway. "Threading the state" means "using ST monad", right? If so, I think we can use algebraic numbers only within ST monad, so it would be too restrictive to do some calculation. > Great work, by the way! :) Thanks! -- Hiromi ISHII konn.jinro at gmail.com -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 496 bytes Desc: Message signed with OpenPGP using GPGMail URL: From ivan.miljenovic at gmail.com Tue Nov 4 09:46:08 2014 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Tue, 4 Nov 2014 20:46:08 +1100 Subject: [Haskell-cafe] Why does this work: 'instance Num (Show a) where' In-Reply-To: <20141104083017.GA15492@weber> References: <20141104083017.GA15492@weber> Message-ID: Is there a corresponding Show datatype? At least with 7.8.3, having just that line gives the following error: The first argument of ?Num? should have kind ?*?, but ?Show a? has kind ?Constraint? In the instance declaration for ?Num (Show a)? On 4 November 2014 19:30, Tom Ellis wrote: > This is accepted by GHC 7.6.3. Is this a bug? What does it mean? > > instance Num (Show a) where > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 4 09:49:35 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 4 Nov 2014 09:49:35 +0000 Subject: [Haskell-cafe] Why does this work: 'instance Num (Show a) where' In-Reply-To: References: <20141104083017.GA15492@weber> Message-ID: <20141104094935.GB15492@weber> No, this is in an otherwise empty file. On Tue, Nov 04, 2014 at 08:46:08PM +1100, Ivan Lazar Miljenovic wrote: > Is there a corresponding Show datatype? > > At least with 7.8.3, having just that line gives the following error: > > The first argument of ?Num? should have kind ?*?, > but ?Show a? has kind ?Constraint? > In the instance declaration for ?Num (Show a)? > > On 4 November 2014 19:30, Tom Ellis > wrote: > > This is accepted by GHC 7.6.3. Is this a bug? What does it mean? > > > > instance Num (Show a) where From travis.cardwell at extellisys.com Tue Nov 4 11:10:41 2014 From: travis.cardwell at extellisys.com (Travis Cardwell) Date: Tue, 04 Nov 2014 20:10:41 +0900 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> <5455FE7F.5000009@extellisys.com> <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> Message-ID: <5458B431.5050803@extellisys.com> Hi Ishii-san, On 2014?11?04? 17:53, Hiromi ISHII wrote: > On 2014/11/02 18:50, Travis Cardwell wrote: >> Looking at your code [1], I see that you are exporting both >> `equalDegreeSplitM`, which uses `uniform` from `Control.Monad.Random`, and >> `equalDegreeFactorM`, which iteratively calls `equalDegreeSplitM`. One of >> the challenges of using a pure uniform stream is threading the state: >> since both functions are exported, implementation details would leak anyway. > > "Threading the state" means "using ST monad", right? > If so, I think we can use algebraic numbers only within ST monad, > so it would be too restrictive to do some calculation. When an algorithm requires values from a uniform distribution, we can generate a uniform stream purely, but progress through the stream must be tracked throughout the whole calculation. This can be done by adding an explicit parameter to each function or via the context of a monad. If the progress through the stream is not tracked, then the same values will be read during each call; that is not uniform, and the algorithm will not work. In my simple ? example, "threading the state" is easy because there is only one function used to do the calculation (`step`). The uniform stream is passed as the first parameter, and two values are used during each iteration. The recursive call passes the rest of the stream, so already used values are not used again. It is more difficult to use this technique with complex algorithms because progress through the uniform stream must be tracked through a calculation that uses multiple, complicated functions. For example, if `factorise` is the top level of the CZ algorithm, then you would need to generate the stream there and thread it through `factorSquareFree`, `equalDegreeFactorM`, and `equalDegreeSplitM`. It is possible to do so using explicit parameters and augmented return values, but that would affect any other uses of the latter two functions, as they are exported. Travis From haskell at jschneider.net Tue Nov 4 12:34:14 2014 From: haskell at jschneider.net (Jon Schneider) Date: Tue, 4 Nov 2014 12:34:14 -0000 Subject: [Haskell-cafe] Cross ghc-7.8.3 for PowerPC build fails Message-ID: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> I got my ARM (v5) ghc cross compiler built the other day by making sure I had only the latest LLVM and Haskell Platform host packages, tweaking settings and commenting out haskeline and terminfo in the top level ghc.mk . There's something broken about terminfo but life's too short to worry about since it's not needed. The ARM cross ghc seems to product viable executables for simple code. Now a sister product is a PowerPC (MPC854E) and the ABI is gnuspe. In my PATH are (only) clangs and llcs from http://llvm.org/releases/3.4.2/clang+llvm-3.4.2-x86_64-unknown-ubuntu12.04.xz and ghc from https://www.haskell.org/platform/download/2014.2.0.0/haskell-platform-2014.2.0.0-unknown-linux-x86_64.tar.gz Because of the none vendor I didn't seem able to put in the target I configured like this. ./configure --target=powerpc-linux-gnuspe --with-gcc=powerpc-none-linux-gnuspe-gcc --with-nm=powerpc-none-linux-gnuspe-nm --with-ld=powerpc-none-linux-gnuspe-ld --with-ar=powerpc-none-linux-gnuspe-ar --with-ranlib=powerpc-none-linux-gnuspe-ranlib This fails as follows. It seems to have generated x86 opcodes including movq unless it's something to do with GNU assembly trying to make everything have the same apparent instruction set then again %rcx and %esi are mentioned. ====== cp libffi/build/inst/lib/libffi.a rts/dist/build/libCffi_thr_l.a "inplace/bin/ghc-stage1" -hisuf hi -osuf o -hcsuf hc -static -H64m -O0 -package-name ghc-prim-0.3.1.0 -hide-all-packages -i -ilibraries/ghc-prim/. -ilibraries/ghc-prim/dist-install/build -ilibraries/ghc-prim/dist-install/build/autogen -Ilibraries/ghc-prim/dist-install/build -Ilibraries/ghc-prim/dist-install/build/autogen -Ilibraries/ghc-prim/. -optP-include -optPlibraries/ghc-prim/dist-install/build/autogen/cabal_macros.h -package rts-1.0 -package-name ghc-prim -XHaskell2010 -O -fllvm -no-user-package-db -rtsopts -odir libraries/ghc-prim/dist-install/build -hidir libraries/ghc-prim/dist-install/build -stubdir libraries/ghc-prim/dist-install/build -c libraries/ghc-prim/./GHC/Types.hs -o libraries/ghc-prim/dist-install/build/GHC/Types.o /tmp/ghc30000_0/ghc30000_5.s: Assembler messages: /tmp/ghc30000_0/ghc30000_5.s:8:0: Error: Unrecognized opcode: `movl' and so on with opcodes such as jbe, leal, jmpq and also "junk at end of line: `rcx),%esi'" ====== in libffi/build/powerpc-unknown-linux-gnuspe there's a sensible config.log with x86_64 in the build variables and powerpc in the host and target ones. How do I go about making this work ? Thanks, Jon From carter.schonwald at gmail.com Tue Nov 4 13:33:45 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 4 Nov 2014 08:33:45 -0500 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> <5455FE7F.5000009@extellisys.com> <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> Message-ID: Threading the state can also mean using the STATE monad as suggested Earlier. On Nov 4, 2014 3:54 AM, "Hiromi ISHII" wrote: > Hi, > > > On 2014/11/02 18:50, Travis Cardwell > wrote: > > > Indeed: many algorithms merely require values from a uniform > distribution, > > not necessarily random numbers. I was hopeful that Cantor-Zassenhaus > > would be one of them. > > > > Looking at your code [1], I see that you are exporting both > > `equalDegreeSplitM`, which uses `uniform` from `Control.Monad.Random`, > and > > `equalDegreeFactorM`, which iteratively calls `equalDegreeSplitM`. One > of > > the challenges of using a pure uniform stream is threading the state: > > since both functions are exported, implementation details would leak > anyway. > > "Threading the state" means "using ST monad", right? > If so, I think we can use algebraic numbers only within ST monad, so it > would be too restrictive to do some calculation. > > > Great work, by the way! :) > > Thanks! > > -- Hiromi ISHII > konn.jinro at gmail.com > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Tue Nov 4 15:18:04 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Tue, 4 Nov 2014 10:18:04 -0500 Subject: [Haskell-cafe] Why does this work: 'instance Num (Show a) where' In-Reply-To: <20141104083017.GA15492@weber> References: <20141104083017.GA15492@weber> Message-ID: <6F2223AE-3677-4CF5-A030-08F3C351D638@cis.upenn.edu> That's a bug. As you surmise, the code is meaningless. It seems to be fixed in 7.8. On Nov 4, 2014, at 3:30 AM, Tom Ellis wrote: > This is accepted by GHC 7.6.3. Is this a bug? What does it mean? > > instance Num (Show a) where > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From kc1956 at gmail.com Tue Nov 4 16:29:48 2014 From: kc1956 at gmail.com (KC) Date: Tue, 4 Nov 2014 08:29:48 -0800 Subject: [Haskell-cafe] How to use randomized algorithm within the implementation of pure data structures? In-Reply-To: References: <6BE22FB3-5F27-4143-B4A4-F98FFB4ED600@gmail.com> <5360D762-87C4-4CF0-9E36-3722C7332498@gmail.com> <5455FE7F.5000009@extellisys.com> <3B568BFC-1083-43D4-AFBE-E56101E07089@gmail.com> Message-ID: Functions are expected to terminate; therefore, one needs the concept of a continuing computation. In Haskell, monads represent the continuing context containing the terminating functions. Having your functions run in a monad is not a limitation. -- -- Sent from an expensive device which will be obsolete in a few months! :D Casey On Nov 4, 2014 5:33 AM, "Carter Schonwald" wrote: > Threading the state can also mean using the STATE monad as suggested > Earlier. > On Nov 4, 2014 3:54 AM, "Hiromi ISHII" wrote: > >> Hi, >> >> >> On 2014/11/02 18:50, Travis Cardwell >> wrote: >> >> > Indeed: many algorithms merely require values from a uniform >> distribution, >> > not necessarily random numbers. I was hopeful that Cantor-Zassenhaus >> > would be one of them. >> > >> > Looking at your code [1], I see that you are exporting both >> > `equalDegreeSplitM`, which uses `uniform` from `Control.Monad.Random`, >> and >> > `equalDegreeFactorM`, which iteratively calls `equalDegreeSplitM`. One >> of >> > the challenges of using a pure uniform stream is threading the state: >> > since both functions are exported, implementation details would leak >> anyway. >> >> "Threading the state" means "using ST monad", right? >> If so, I think we can use algebraic numbers only within ST monad, so it >> would be too restrictive to do some calculation. >> >> > Great work, by the way! :) >> >> Thanks! >> >> -- Hiromi ISHII >> konn.jinro at gmail.com >> >> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.sorokin at gmail.com Tue Nov 4 16:43:29 2014 From: david.sorokin at gmail.com (David Sorokin) Date: Tue, 4 Nov 2014 19:43:29 +0300 Subject: [Haskell-cafe] [ANN] Simulation library aivika-3.0 Message-ID: <3D216D1D-39D1-4A22-A96A-EF9F19497ECD@gmail.com> Hi Cafe, I?m glad to announce a new release of my simulation library Aivika written in Haskell. It is focused on DES and System Dynamics. I strongly recommend to upgrade to this version for everyone who uses my library. It contains an important fix in that how the TimingStats statistics is gathered. A more simple SamplingStats is usually used. But in the recent versions I started using more widely TimingStats too. This is a kind of (immutable) statistics which is bound up to the simulation time. For example, the queue size statistics is collected as TimingStats, while other queue properties are usually collected as SamplingStats. The SamplingStats is used to be working. But I felt that there was something wrong with TimingStats. Now TimingStats is finally fixed. As a consequence, the queueRate function gives us a result, which suits very well to Little?s rule with good precision in the examples included in the distributive. So, please upgrade to a new version of Aivika (and related libraries) as possible. Besides, I added debugging facilities to the library. These are functions traceEvent, traceProcess, traceStream and so on. They allow tracing the behavior of the simulation model in time. Finally, the Aivika simulation library can be definitely translated to JavaScript with help of the Haste compiler and it works fine! Only I had to use random numbers different from that one, which is specified with help of the SimpleGenerator data constructor. Please read the notes [2] on the wiki page of my project on GitHub. Thanks, David [1] http://hackage.haskell.org/package/aivika [2] https://github.com/dsorokin/aivika/wiki/Compiling-to-JavaScript -------------- next part -------------- An HTML attachment was scrubbed... URL: From codygman.consulting at gmail.com Tue Nov 4 20:08:10 2014 From: codygman.consulting at gmail.com (Cody Goodman) Date: Tue, 4 Nov 2014 14:08:10 -0600 Subject: [Haskell-cafe] Debugging Wreq/http-client https requests In-Reply-To: References: Message-ID: I did end up using mitmproxy. However I didn't know about generating my own certificate and made wreq ignore certificate settings. Your solution is better I think, thanks. On Mon, Nov 3, 2014 at 4:09 AM, Tomas Carnecky wrote: > You can use mitmproxy with a self-generated certificate. That will > work even if you can't control the URL where the app sends the > requests to, simply add the hostname to your /etc/hosts and point it > to 127.0.0.1. > > On Sat, Nov 1, 2014 at 12:16 AM, Cody Goodman > wrote: >> I have a program that is POST'ing some data to a remote server. >> However, some part of the data I'm sending is wrong I believe. >> >> If this were plain http without encryption, wireshark would allow me >> to see the exact data being sent over the wire. However, with https it >> is encrypted. >> >> Is there an inbuilt way to debug requests sent by wreq or more likely, >> a way to output debug info for http-client? >> >> Alternatively, is there a way to use NSS support with either of these libraries: >> >> http://security.stackexchange.com/questions/35639/decrypting-tls-in-wireshark-when-using-dhe-rsa-ciphersuites >> >> Thanks in advance to all for your time. >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe From codygman.consulting at gmail.com Tue Nov 4 20:10:15 2014 From: codygman.consulting at gmail.com (Cody Goodman) Date: Tue, 4 Nov 2014 14:10:15 -0600 Subject: [Haskell-cafe] Debugging Wreq/http-client https requests In-Reply-To: References: Message-ID: Thanks for the example Michael, I ended up skipping cert checks but it's nice to know how to override the tlsConnection like this. On Sat, Nov 1, 2014 at 11:50 AM, Michael Snoyman wrote: > We can certainly make this process more official/easier to use, but > http-client does support this. Manager has a field mTlsConnection which > specifies how to create a Connection value to a TLS server. Connection is a > relatively simple datatype that specifies what to do, e.g., when sending > data to a server. If you wanted to log all of that writes to a file, you > might do something like: > > mOrig <- newManager tlsManagerSettings > let m = mOrig > { mTlsConnection = \ha h p -> do > connOrig <- mTlsConnection mOrig ha h p > return connOrig { connectionWrite = \bs -> do > S.appendFile "/tmp/log" bs > connectionWrite connOrig bs > } > } > > On Sat, Nov 1, 2014 at 1:16 AM, Cody Goodman > wrote: >> >> I have a program that is POST'ing some data to a remote server. >> However, some part of the data I'm sending is wrong I believe. >> >> If this were plain http without encryption, wireshark would allow me >> to see the exact data being sent over the wire. However, with https it >> is encrypted. >> >> Is there an inbuilt way to debug requests sent by wreq or more likely, >> a way to output debug info for http-client? >> >> Alternatively, is there a way to use NSS support with either of these >> libraries: >> >> >> http://security.stackexchange.com/questions/35639/decrypting-tls-in-wireshark-when-using-dhe-rsa-ciphersuites >> >> Thanks in advance to all for your time. >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe > > From agocorona at gmail.com Tue Nov 4 22:49:28 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Tue, 4 Nov 2014 23:49:28 +0100 Subject: [Haskell-cafe] Tutorial for creating haskell apps in the browser easy Message-ID: Hi Just in case you don?t noticed it, this is the first tutorial for creating Browser applications in Haskell for non haskellers. http://www.airpair.com/haskell/posts/haskell-tutorial-introduction-to-web-apps -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From vigalchin at gmail.com Wed Nov 5 06:35:35 2014 From: vigalchin at gmail.com (Vasili I. Galchin) Date: Wed, 5 Nov 2014 00:35:35 -0600 Subject: [Haskell-cafe] installing haskell on ubuntu using apt-get?? Message-ID: My config: runghc 7.4.1 3.2.0-61-generic #93-Ubuntu I installed Haskell using Ubuntu's "apt-get install" ======================================================== Please see results below ... (should I instead install Haskell from haskell.org??) vasili at vasili-VirtualBox:~/biolib$ cabal configure Resolving dependencies... Configuring bio-0.5.2... Warning: This package indirectly depends on multiple versions of the same package. This is highly likely to cause a compile failure. package text-1.2.0.0 requires bytestring-0.10.4.0 package tagsoup-0.13.3 requires bytestring-0.10.4.0 package parsec-3.1.7 requires bytestring-0.10.4.0 package bio-0.5.2 requires bytestring-0.10.4.0 package binary-0.4.5 requires bytestring-0.10.4.0 package unix-2.5.1.0 requires bytestring-0.9.2.1 vasili at vasili-VirtualBox:~/biolib$ -------------- next part -------------- An HTML attachment was scrubbed... URL: From ckkashyap at gmail.com Wed Nov 5 06:41:34 2014 From: ckkashyap at gmail.com (C K Kashyap) Date: Wed, 5 Nov 2014 12:11:34 +0530 Subject: [Haskell-cafe] installing haskell on ubuntu using apt-get?? In-Reply-To: References: Message-ID: Hi Vasili ... did you install haskell platform? If not, I suggest that you install haskell-platform using apt-get. Regards, Kashyap On Wed, Nov 5, 2014 at 12:05 PM, Vasili I. Galchin wrote: > My config: > > runghc 7.4.1 > > 3.2.0-61-generic #93-Ubuntu > > I installed Haskell using Ubuntu's "apt-get install" > > ======================================================== > > > Please see results below ... (should I instead install Haskell from > haskell.org??) > > vasili at vasili-VirtualBox:~/biolib$ cabal configure > Resolving dependencies... > Configuring bio-0.5.2... > Warning: This package indirectly depends on multiple versions of the same > package. This is highly likely to cause a compile failure. > package text-1.2.0.0 requires bytestring-0.10.4.0 > package tagsoup-0.13.3 requires bytestring-0.10.4.0 > package parsec-3.1.7 requires bytestring-0.10.4.0 > package bio-0.5.2 requires bytestring-0.10.4.0 > package binary-0.4.5 requires bytestring-0.10.4.0 > package unix-2.5.1.0 requires bytestring-0.9.2.1 > vasili at vasili-VirtualBox:~/biolib$ > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Wed Nov 5 07:21:42 2014 From: michael at snoyman.com (Michael Snoyman) Date: Wed, 5 Nov 2014 09:21:42 +0200 Subject: [Haskell-cafe] installing haskell on ubuntu using apt-get?? In-Reply-To: References: Message-ID: I'd recommend using Herbert's PPA for installing GHC so you get something newer. bitemyapp has a good guide[1]. I'd also recommend following the Stackage installation guide[2], which builds on top of bitemyapp's guide. [1] https://github.com/bitemyapp/learnhaskell#getting-started [2] https://github.com/fpco/stackage/wiki/Preparing-your-system-to-use-Stackage On Wed, Nov 5, 2014 at 8:35 AM, Vasili I. Galchin wrote: > My config: > > runghc 7.4.1 > > 3.2.0-61-generic #93-Ubuntu > > I installed Haskell using Ubuntu's "apt-get install" > > ======================================================== > > > Please see results below ... (should I instead install Haskell from > haskell.org??) > > vasili at vasili-VirtualBox:~/biolib$ cabal configure > Resolving dependencies... > Configuring bio-0.5.2... > Warning: This package indirectly depends on multiple versions of the same > package. This is highly likely to cause a compile failure. > package text-1.2.0.0 requires bytestring-0.10.4.0 > package tagsoup-0.13.3 requires bytestring-0.10.4.0 > package parsec-3.1.7 requires bytestring-0.10.4.0 > package bio-0.5.2 requires bytestring-0.10.4.0 > package binary-0.4.5 requires bytestring-0.10.4.0 > package unix-2.5.1.0 requires bytestring-0.9.2.1 > vasili at vasili-VirtualBox:~/biolib$ > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From haskell at ibotty.net Wed Nov 5 07:52:12 2014 From: haskell at ibotty.net (Tobias Florek) Date: Wed, 05 Nov 2014 08:52:12 +0100 Subject: [Haskell-cafe] Debugging Wreq/http-client https requests In-Reply-To: References: Message-ID: <20141105075212.5467.44324@x201> Hi, > I ended up skipping cert checks Please don't! Skipping certificate checks is bad. Man in the middle attacks (mitm) are real in the internet. Generating your own certificate is pretty easy on unix-like os'es and you will only have to do it once anyway. Search for certificate authority and openssl and you will find many examples on how to do it. Cheers, tobias florek From lambda.fairy at gmail.com Wed Nov 5 08:26:38 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Wed, 5 Nov 2014 21:26:38 +1300 Subject: [Haskell-cafe] installing haskell on ubuntu using apt-get?? In-Reply-To: References: Message-ID: Hi Vasili, Your problem looks like Cabal hell [1]. The solution to that is to clear the package database and start over, which should be as simple as rm -r ~/.ghc As long as you haven't installed packages globally (sudo cabal install) that should be enough. On Wed, Nov 5, 2014 at 8:21 PM, Michael Snoyman wrote: > I'd recommend using Herbert's PPA for installing GHC so you get something > newer. bitemyapp has a good guide[1]. I'd also recommend following the > Stackage installation guide[2], which builds on top of bitemyapp's guide. > > [1] https://github.com/bitemyapp/learnhaskell#getting-started > [2] > https://github.com/fpco/stackage/wiki/Preparing-your-system-to-use-Stackage I second this. Haskell development moves quickly, so it's important to have (relatively) recent tools. Once you have Cabal 1.20 installed, I recommend reading up on package sandboxes too [2]. They can make these version conflicts easier to deal with in the future. Chris [1] http://cdsmith.wordpress.com/2011/01/17/the-butterfly-effect-in-cabal/ [2] http://coldwa.st/e/blog/2013-08-20-Cabal-sandbox.html From agocorona at gmail.com Wed Nov 5 09:47:35 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Wed, 5 Nov 2014 10:47:35 +0100 Subject: [Haskell-cafe] Tutorial for creating haskell apps in the browser easy In-Reply-To: References: Message-ID: I feel like Prometheus, the semi-god that teach humans how to make fire, a privilege of the gods. Will I receive the wrath of the gods of Category Theory for revealing the secret? There will be an industrial Hercules? 2014-11-04 23:49 GMT+01:00 Alberto G. Corona : > Hi > > Just in case you don?t noticed it, this is the first tutorial for creating > Browser applications in Haskell for non haskellers. > > > http://www.airpair.com/haskell/posts/haskell-tutorial-introduction-to-web-apps > > -- > Alberto. > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From hjgtuyl at chello.nl Wed Nov 5 13:37:56 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Wed, 05 Nov 2014 14:37:56 +0100 Subject: [Haskell-cafe] Tutorial for creating haskell apps in the browser easy In-Reply-To: References: Message-ID: There is a good chance that you will be punished for eternity, that your liver will be eaten daily by a monad. On Wed, 05 Nov 2014 10:47:35 +0100, Alberto G. Corona wrote: > I feel like Prometheus, the semi-god that teach humans how to make fire, > a > privilege of the gods. > > Will I receive the wrath of the gods of Category Theory for revealing the > secret? There will be an industrial Hercules? > > 2014-11-04 23:49 GMT+01:00 Alberto G. Corona : > >> Hi >> >> Just in case you don?t noticed it, this is the first tutorial for >> creating >> Browser applications in Haskell for non haskellers. >> >> >> http://www.airpair.com/haskell/posts/haskell-tutorial-introduction-to-web-apps >> >> -- >> Alberto. >> -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From gale at sefer.org Wed Nov 5 16:44:11 2014 From: gale at sefer.org (Yitzchak Gale) Date: Wed, 5 Nov 2014 18:44:11 +0200 Subject: [Haskell-cafe] addCatch in conduit Message-ID: In getting the dtd library to compile with recent versions of conduit (yes, I know that it's deprecated and Michael longer supports it, but we still need it), we came across the following bit of code: -- (snip) -- CI.ConduitM $ addCatch $ CI.unConduitM src0 where -- (snip) -- addCatch :: (MonadThrow m, MonadBaseControl IO m) => CI.Pipe l i o u m r -> CI.Pipe l i o u m r addCatch (CI.HaveOutput src close x) = CI.HaveOutput (addCatch src) (addCatch' close) x addCatch (CI.NeedInput p c) = CI.NeedInput (addCatch . p) (addCatch . c) addCatch (CI.Done r) = CI.Done r addCatch (CI.PipeM msrc) = CI.PipeM (addCatch' $ liftM addCatch msrc) addCatch (CI.Leftover p i) = CI.Leftover (addCatch p) i addCatch' m = m `Lifted.catch` throw rr We adapted it to the new ConduitM type simply by changing the first line to: CI.ConduitM $ addCatch . CI.unConduitM src0 Not bad, a diff of exactly one character. It compiles and seems to work. Does this sound reasonable? Obviously, we would love to get rid of this use of conduit internals. addCatch seems like a general operation, not specific to this library. Is there a way to do this in modern conduit without dipping into internals? If not - can we propose to add it? Thanks, Yitz From agocorona at gmail.com Wed Nov 5 18:50:44 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Wed, 5 Nov 2014 19:50:44 +0100 Subject: [Haskell-cafe] Tutorial for creating haskell apps in the browser easy In-Reply-To: References: Message-ID: They are eating my brain already! 2014-11-05 14:37 GMT+01:00 Henk-Jan van Tuyl : > > There is a good chance that you will be punished for eternity, that your > liver will be eaten daily by a monad. > > > On Wed, 05 Nov 2014 10:47:35 +0100, Alberto G. Corona < > agocorona at gmail.com> wrote: > > I feel like Prometheus, the semi-god that teach humans how to make fire, a >> privilege of the gods. >> >> Will I receive the wrath of the gods of Category Theory for revealing the >> secret? There will be an industrial Hercules? >> >> 2014-11-04 23:49 GMT+01:00 Alberto G. Corona : >> >> Hi >>> >>> Just in case you don?t noticed it, this is the first tutorial for >>> creating >>> Browser applications in Haskell for non haskellers. >>> >>> >>> http://www.airpair.com/haskell/posts/haskell- >>> tutorial-introduction-to-web-apps >>> >>> -- >>> Alberto. >>> >>> > -- > Folding at home > What if you could share your unused computer power to help find a cure? In > just 5 minutes you can join the world's biggest networked computer and get > us closer sooner. Watch the video. > http://folding.stanford.edu/ > > > http://Van.Tuyl.eu/ > http://members.chello.nl/hjgtuyl/tourdemonad.html > Haskell programming > -- > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Thu Nov 6 06:27:07 2014 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 6 Nov 2014 08:27:07 +0200 Subject: [Haskell-cafe] addCatch in conduit In-Reply-To: References: Message-ID: On Wed, Nov 5, 2014 at 6:44 PM, Yitzchak Gale wrote: > In getting the dtd library to compile with recent versions > of conduit (yes, I know that it's deprecated and Michael > longer supports it, but we still need it), we came across > the following bit of code: > > -- (snip) -- > CI.ConduitM $ addCatch $ CI.unConduitM src0 > where > -- (snip) -- > addCatch :: (MonadThrow m, MonadBaseControl IO m) > => CI.Pipe l i o u m r > -> CI.Pipe l i o u m r > addCatch (CI.HaveOutput src close x) = CI.HaveOutput (addCatch > src) (addCatch' close) x > addCatch (CI.NeedInput p c) = CI.NeedInput (addCatch . p) (addCatch . > c) > addCatch (CI.Done r) = CI.Done r > addCatch (CI.PipeM msrc) = CI.PipeM (addCatch' $ liftM addCatch msrc) > addCatch (CI.Leftover p i) = CI.Leftover (addCatch p) i > > addCatch' m = m `Lifted.catch` throw rr > > We adapted it to the new ConduitM type simply by changing > the first line to: > > CI.ConduitM $ addCatch . CI.unConduitM src0 > > Not bad, a diff of exactly one character. It compiles and seems > to work. Does this sound reasonable? > > Obviously, we would love to get rid of this use of conduit internals. > addCatch seems like a general operation, not specific to this > library. Is there a way to do this in modern conduit without dipping > into internals? If not - can we propose to add it? > > Thanks, > Yitz > That won't work due to how the CPS/codensity transform works. You'll end up applying the exception catcher to the *entire* pipeline, not just the part that's currently delimited. To give a more easily understood example, it's best to look at difference lists (which I think are always a good way to understand CPS better). I've put together an example here: https://www.fpcomplete.com/user/snoyberg/random-code-snippets/cps-transform-example badMap ends up lower casing the entire list. If you stare at it long enough, the reason becomes obvious: we're keeping our current portion of the list as a function, applying that function to the rest of the list, and *then* applying our map. Instead, goodMap needs to apply the current portion of the list to the empty list to get a concrete list that can be traversed, traverse it, and then convert it back to a difference list. However, this is a little bit inefficient, since we'll first traverse the list once to apply the mapped function, and then traverse it a second time to go back to the CPS version. Instead, we can combine the two into a single step, leading to more efficient (but less readable) code in efficientMap. All that said: the functionality you need there is now provided by conduit out of the box via its `MonadCatch` (from the exceptions package) instance. It may be useful to look at its implementation: https://github.com/snoyberg/conduit/blob/dbb49aa2a69e00a8817ec98ffc99f0523a84d0eb/conduit/Data/Conduit/Internal/Conduit.hs#L159 The catchC function is similar, but uses MonadBaseControl instead of MonadCatch: https://github.com/snoyberg/conduit/blob/dbb49aa2a69e00a8817ec98ffc99f0523a84d0eb/conduit/Data/Conduit/Internal/Conduit.hs#L427 Full code of my snippet for the lazy: import Data.Char (toLower) import Data.Monoid newtype DList a = DList { unDList :: [a] -> [a] } instance Monoid (DList a) where mempty = DList id mappend (DList x) (DList y) = DList (x . y) fromList :: [a] -> DList a fromList xs = DList (xs ++) toList :: DList a -> [a] toList (DList x) = x [] badMap :: (a -> a) -> DList a -> DList a badMap f d = DList $ map f . unDList d goodMap :: (a -> b) -> DList a -> DList b goodMap f = fromList . map f . toList efficientMap :: (a -> b) -> DList a -> DList b efficientMap f = DList . go . toList where go [] = id go (x:xs) = (f x:) . go xs main :: IO () main = do putStrLn $ toList $ badMap toLower (fromList "HELLO") <> fromList "WORLD" putStrLn $ toList $ goodMap toLower (fromList "HELLO") <> fromList "WORLD" putStrLn $ toList $ efficientMap toLower (fromList "HELLO") <> fromList "WORLD" -------------- next part -------------- An HTML attachment was scrubbed... URL: From karel.gardas at centrum.cz Thu Nov 6 08:47:43 2014 From: karel.gardas at centrum.cz (Karel Gardas) Date: Thu, 06 Nov 2014 09:47:43 +0100 Subject: [Haskell-cafe] Cross ghc-7.8.3 for PowerPC build fails In-Reply-To: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> References: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> Message-ID: <545B35AF.2020009@centrum.cz> I'd use NCG instead of LLVM and still there is something fishy about your setup since this generated assembly looks like x86 to me. Cheers, Karel On 11/ 4/14 01:34 PM, Jon Schneider wrote: > libraries/ghc-prim/dist-install/build/GHC/Types.o > /tmp/ghc30000_0/ghc30000_5.s: Assembler messages: > > /tmp/ghc30000_0/ghc30000_5.s:8:0: > Error: Unrecognized opcode: `movl' > and so on with opcodes such as jbe, leal, jmpq and also "junk at end of > line: `rcx),%esi'" > ====== From haskell at jschneider.net Thu Nov 6 09:26:16 2014 From: haskell at jschneider.net (Jon Schneider) Date: Thu, 6 Nov 2014 09:26:16 -0000 Subject: [Haskell-cafe] Cross ghc-7.8.3 for PowerPC build fails In-Reply-To: <545B35AF.2020009@centrum.cz> References: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> <545B35AF.2020009@centrum.cz> Message-ID: <2bfd307c362906203162c11dd80d48b2.squirrel@mail.jschneider.net> Definitely but given I've just switched from a successfulish looking ARM version to a PowerPC x86 popping out was the last thing I expected. Though it's not the first time I have attempted to cross-compile with (slightly older versions of) clang/LLVM and found it confused about its architectures. I have since knocked the -fllvm from SRC_HC_OPTS and GhcStage1HcOpts and that got me past the immediate hurdle producing a powerpc---ghc which which I could compile a helloworld.hs but the result hangs. So far I've only got as far as checking that yes the entry point, _start has PowerPC and not complete garbage code. I shall dig a bit deeper today equipped with a flimsy knowledge of both Haskell and PowerPC. Jon > > I'd use NCG instead of LLVM and still there is something fishy about > your setup since this generated assembly looks like x86 to me. > > Cheers, > Karel > > On 11/ 4/14 01:34 PM, Jon Schneider wrote: >> libraries/ghc-prim/dist-install/build/GHC/Types.o >> /tmp/ghc30000_0/ghc30000_5.s: Assembler messages: >> >> /tmp/ghc30000_0/ghc30000_5.s:8:0: >> Error: Unrecognized opcode: `movl' >> and so on with opcodes such as jbe, leal, jmpq and also "junk at end of >> line: `rcx),%esi'" >> ====== > > From karel.gardas at centrum.cz Thu Nov 6 11:08:45 2014 From: karel.gardas at centrum.cz (Karel Gardas) Date: Thu, 06 Nov 2014 12:08:45 +0100 Subject: [Haskell-cafe] Cross ghc-7.8.3 for PowerPC build fails In-Reply-To: <2bfd307c362906203162c11dd80d48b2.squirrel@mail.jschneider.net> References: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> <545B35AF.2020009@centrum.cz> <2bfd307c362906203162c11dd80d48b2.squirrel@mail.jschneider.net> Message-ID: <545B56BD.1050500@centrum.cz> Considering that cross-compilation is a little-bit on bleeding edge still I would recommend to use common 32bit PowerPC host first to build and *test* GHC to know there is no outstanding issue. Then, when you know PPC NCG is in a good shape you can continue with cross-compilation attempts... Karel On 11/ 6/14 10:26 AM, Jon Schneider wrote: > Definitely but given I've just switched from a successfulish looking ARM > version to a PowerPC x86 popping out was the last thing I expected. > > Though it's not the first time I have attempted to cross-compile with > (slightly older versions of) clang/LLVM and found it confused about its > architectures. > > I have since knocked the -fllvm from SRC_HC_OPTS and GhcStage1HcOpts and > that got me past the immediate hurdle producing a powerpc---ghc which > which I could compile a helloworld.hs but the result hangs. So far I've > only got as far as checking that yes the entry point, _start has PowerPC > and not complete garbage code. I shall dig a bit deeper today equipped > with a flimsy knowledge of both Haskell and PowerPC. > > Jon > >> >> I'd use NCG instead of LLVM and still there is something fishy about >> your setup since this generated assembly looks like x86 to me. >> >> Cheers, >> Karel >> >> On 11/ 4/14 01:34 PM, Jon Schneider wrote: >>> libraries/ghc-prim/dist-install/build/GHC/Types.o >>> /tmp/ghc30000_0/ghc30000_5.s: Assembler messages: >>> >>> /tmp/ghc30000_0/ghc30000_5.s:8:0: >>> Error: Unrecognized opcode: `movl' >>> and so on with opcodes such as jbe, leal, jmpq and also "junk at end of >>> line: `rcx),%esi'" >>> ====== >> >> > > From haskell at jschneider.net Thu Nov 6 11:26:00 2014 From: haskell at jschneider.net (Jon Schneider) Date: Thu, 6 Nov 2014 11:26:00 -0000 Subject: [Haskell-cafe] Cross ghc-7.8.3 for PowerPC build fails In-Reply-To: <545B56BD.1050500@centrum.cz> References: <3877c0e28547558366bee9210575b4e9.squirrel@mail.jschneider.net> <545B35AF.2020009@centrum.cz> <2bfd307c362906203162c11dd80d48b2.squirrel@mail.jschneider.net> <545B56BD.1050500@centrum.cz> Message-ID: I finally got some PowerPC output but found it hung (on the target). I suspected it might be that we're using an SPE rather than the more common EABI but quickly found that it is due to https://ghc.haskell.org/trac/ghc/ticket/7695, possibly to be fixed soon according to the clear status notes for 7.10.1 and in any case easily work roundable by providing a UTF-32.so . Further good news is that what we want to do is purely mathematical manipulating only bitmaps, already has an implementation with tests in another language and ought to lend itself well to Haskell according to my learned colleague. So we can now proceed with some gentle performance testing on both our product platforms. I assume that NGC is what you get by default. helloworld works with or without -fvia-C when it clearly uses power---gcc. Jon From waldmann at imn.htwk-leipzig.de Thu Nov 6 14:40:36 2014 From: waldmann at imn.htwk-leipzig.de (Johannes Waldmann) Date: Thu, 6 Nov 2014 14:40:36 +0000 (UTC) Subject: [Haskell-cafe] why is haddock so slow Message-ID: I have a larg-ish project (800 modules) and these ghc compilation times: cabal install : 19 min cabal install --disable-doc : 13 min the compilation includes the profiling build. That is, running haddock takes the same 6 minutes as running the compiler (with optimization) I also built with "optimization: False library-profiling: False" and this takes 3 min. I understand that haddockification goes via the compiler's front-end to resolve names and infer types. This takes 3 min (as the non-optimizing compiler run shows). What does haddock do in the other 3 min? What could I do to help analyze this? - J.W. (ghc-7.8.3, haddock 2.15.0, rotating disk (not SSD), Fedora 20, x86_64) From hjgtuyl at chello.nl Fri Nov 7 14:09:16 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Fri, 07 Nov 2014 15:09:16 +0100 Subject: [Haskell-cafe] Haskell.org access problems Message-ID: L.S., When I try to browse haskell.org with Opera, I get the following message: --- Unable to complete secure transaction You tried to access the address http://www.haskell.org/, which is currently unavailable. Please make sure that the web address (URL) is correctly spelled and punctuated, then try reloading the page. Secure connection: fatal error (1066) https://www.haskell.org/ Unable to verify the website's identity (OCSP error). The response from the online certificate validation (OCSP) server was too old. --- The browser doesn't allow me in. Another thing that I get with Firefox: a captcha, probably because I am using the TOR network and the site is buffered by CloudFlare. Opera does not handle these captchas properly. Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From fuuzetsu at fuuzetsu.co.uk Fri Nov 7 14:56:42 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Fri, 07 Nov 2014 14:56:42 +0000 Subject: [Haskell-cafe] why is haddock so slow In-Reply-To: References: Message-ID: <545CDDAA.1030908@fuuzetsu.co.uk> On 11/06/2014 02:40 PM, Johannes Waldmann wrote: > I have a larg-ish project (800 modules) and these ghc compilation times: > > cabal install : 19 min > cabal install --disable-doc : 13 min > > the compilation includes the profiling build. > > That is, running haddock takes the same 6 minutes > as running the compiler (with optimization) > > I also built with "optimization: False library-profiling: False" > and this takes 3 min. > > I understand that haddockification goes via the compiler's front-end > to resolve names and infer types. > This takes 3 min (as the non-optimizing compiler run shows). How do you measure this? > What does haddock do in the other 3 min? > > What could I do to help analyze this? Probably running profiled Haddock executable is the best way to get more insight. Also check your RAM usage because it can get very high as per https://github.com/haskell/haddock/issues/295 . I'll very happily take performance-improving patches. If you can provide some kind of meaningful performance data then that's useful too. > - J.W. > > (ghc-7.8.3, haddock 2.15.0, rotating disk (not SSD), Fedora 20, x86_64) > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Mateusz K. From fuuzetsu at fuuzetsu.co.uk Fri Nov 7 15:09:41 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Fri, 07 Nov 2014 15:09:41 +0000 Subject: [Haskell-cafe] why is haddock so slow In-Reply-To: <545CDDAA.1030908@fuuzetsu.co.uk> References: <545CDDAA.1030908@fuuzetsu.co.uk> Message-ID: <545CE0B5.9020102@fuuzetsu.co.uk> On 11/07/2014 02:56 PM, Mateusz Kowalczyk wrote: > On 11/06/2014 02:40 PM, Johannes Waldmann wrote: >> I have a larg-ish project (800 modules) and these ghc compilation times: >> >> cabal install : 19 min >> cabal install --disable-doc : 13 min >> >> the compilation includes the profiling build. >> >> That is, running haddock takes the same 6 minutes >> as running the compiler (with optimization) >> >> I also built with "optimization: False library-profiling: False" >> and this takes 3 min. >> >> I understand that haddockification goes via the compiler's front-end >> to resolve names and infer types. >> This takes 3 min (as the non-optimizing compiler run shows). > > How do you measure this? Sorry, missed a section, I see now. I think it's bed time for me ;). >> What does haddock do in the other 3 min? >> >> What could I do to help analyze this? > > Probably running profiled Haddock executable is the best way to get more > insight. Also check your RAM usage because it can get very high as per > https://github.com/haskell/haddock/issues/295 . > > I'll very happily take performance-improving patches. If you can provide > some kind of meaningful performance data then that's useful too. > > >> - J.W. >> >> (ghc-7.8.3, haddock 2.15.0, rotating disk (not SSD), Fedora 20, x86_64) >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > -- Mateusz K. From semen at trygub.com Fri Nov 7 15:35:49 2014 From: semen at trygub.com (Semen Trygubenko / =?utf-8?B?0KHQtdC80LXQvSDQotGA0LjQs9GD0LHQtdC9?= =?utf-8?B?0LrQvg==?=) Date: Fri, 7 Nov 2014 15:35:49 +0000 Subject: [Haskell-cafe] cabal keeps relinking Message-ID: <20141107153549.GD64515@inanna.trygub.com> Dear Haskell-Cafe, cabal seems to be re-linking every time I run cabal build Wait was not an issue for small projects but for big ones it is starting to get in the way? How could I persuade cabal to re-link only if there are changes in the source tree and only these exes that require it? Many thanks, Semen PS I googled around and found this https://www.haskell.org/pipermail/libraries/2005-August/004306.html which seems to imply relink is (was?) conditional on multiple exes being present in the project. However, for me it was always relinking regardless. -- ????? ?????????? http://trygub.com -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 181 bytes Desc: not available URL: From icfp.publicity at googlemail.com Fri Nov 7 16:45:59 2014 From: icfp.publicity at googlemail.com (David Van Horn) Date: Fri, 7 Nov 2014 11:45:59 -0500 Subject: [Haskell-cafe] ICFP 2015: Call for Papers Message-ID: ===================================================================== 20th ACM SIGPLAN International Conference on Functional Programming ICFP 2015 Vancouver, Canada, August 31 - September 2, 2015 http://www.icfpconference.org/icfp2015 ===================================================================== Important Dates ~~~~~~~~~~~~~~~ Submissions due: Friday, February 27 2015, 23:59 UTC-11 Author response: Tuesday, April 21, 2015 through Thursday, 23 April, 2015 Notification: Friday, May 1, 2015 Final copy due: Friday, June 12, 2015 Scope ~~~~~ ICFP 2015 seeks original papers on the art and science of functional programming. Submissions are invited on all topics from principles to practice, from foundations to features, and from abstraction to application. The scope includes all languages that encourage functional programming, including both purely applicative and imperative languages, as well as languages with objects, concurrency, or parallelism. Topics of interest include (but are not limited to): * Language Design: concurrency, parallelism, and distribution; modules; components and composition; metaprogramming; type systems; interoperability; domain-specific languages; and relations to imperative, object-oriented, or logic programming. * Implementation: abstract machines; virtual machines; interpretation; compilation; compile-time and run-time optimization; garbage collection and memory management; multi-threading; exploiting parallel hardware; interfaces to foreign functions, services, components, or low-level machine resources. * Software-Development Techniques: algorithms and data structures; design patterns; specification; verification; validation; proof assistants; debugging; testing; tracing; profiling. * Foundations: formal semantics; lambda calculus; rewriting; type theory; monads; continuations; control; state; effects; program verification; dependent types. * Analysis and Transformation: control-flow; data-flow; abstract interpretation; partial evaluation; program calculation. * Applications: symbolic computing; formal-methods tools; artificial intelligence; systems programming; distributed-systems and web programming; hardware design; databases; XML processing; scientific and numerical computing; graphical user interfaces; multimedia and 3D graphics programming; scripting; system administration; security. * Education: teaching introductory programming; parallel programming; mathematical proof; algebra. * Functional Pearls: elegant, instructive, and fun essays on functional programming. * Experience Reports: short papers that provide evidence that functional programming really works or describe obstacles that have kept it from working. If you are concerned about the appropriateness of some topic, do not hesitate to contact the program chair. Abbreviated instructions for authors ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * By Friday, 27 February 2015, 23:59 UTC-11 (anywhere in the world), submit a full paper of at most 12 pages (6 pages for an Experience Report) in standard ACM conference format, including bibliography, figures, and appendices. The deadlines will be strictly enforced and papers exceeding the page limits will be summarily rejected. * Authors have the option to attach supplementary material to a submission, on the understanding that reviewers may choose not to look at it. * Each submission must adhere to SIGPLAN's republication policy, as explained on the web at http://www.sigplan.org/Resources/Policies/Republication * Authors of resubmitted (but previously rejected) papers have the option to attach an annotated copy of the reviews of their previous submission(s), explaining how they have addressed these previous reviews in the present submission. If a reviewer identifies him/herself as a reviewer of this previous submission and wishes to see how his/her comments have been addressed, the program chair will communicate to this reviewer the annotated copy of his/her previous review. Otherwise, no reviewer will read the annotated copies of the previous reviews. Overall, a submission will be evaluated according to its relevance, correctness, significance, originality, and clarity. It should explain its contributions in both general and technical terms, clearly identifying what has been accomplished, explaining why it is significant, and comparing it with previous work. The technical content should be accessible to a broad audience. Functional Pearls and Experience Reports are separate categories of papers that need not report original research results and must be marked as such at the time of submission. Detailed guidelines on both categories are on the conference web site. Proceedings will be published by ACM Press. Authors of accepted submissions will have a choice of one of three ways to manage their publication rights. These choices are described at http://authors.acm.org/main.html Presentations will be videotaped and released online if the presenter consents. The proceedings will be freely available for download from the ACM Digital Library from one week before the start of the conference until two weeks after the conference. Formatting: Submissions must be in PDF format printable in black and white on US Letter sized paper and interpretable by Ghostscript. Papers must adhere to the standard ACM conference format: two columns, nine-point font on a ten-point baseline, with columns 20pc (3.33in) wide and 54pc (9in) tall, with a column gutter of 2pc (0.33in). A suitable document template for LaTeX is available at http://www.acm.org/sigs/sigplan/authorInformation.htm Submission: Submissions will be accepted on the web using a link that will be posted at http://icfpconference.org/icfp2015/ Improved versions of a paper may be submitted at any point before the submission deadline using the same web interface. Author response: Authors will have a 72-hour period, starting at 0:00 UTC on Tuesday, 21 April 2015, to read reviews and respond to them. ACM Author-Izer is a unique service that enables ACM authors to generate and post links on either their home page or institutional repository for visitors to download the definitive version of their articles from the ACM Digital Library at no charge. Downloads through Author-Izer links are captured in official ACM statistics, improving the accuracy of usage and impact measurements. Consistently linking the definitive version of ACM article should reduce user confusion over article versioning. After your article has been published and assigned to your ACM Author Profile page, please visit http://www.acm.org/publications/acm-author-izer-service to learn how to create your links for free downloads from the ACM DL. Publication date: The official publication date of accepted papers is the date the proceedings are made available in the ACM Digital Library. This date may be up to two weeks prior to the first day of the conference. The official publication date affects the deadline for any patent filings related to published work. General Chair: Kathleen Fisher Tufts University (USA) Program Chair: John Reppy University of Chicago (USA) Program Committee: Amal Ahmed Northeastern University (USA) Jean-Philippe Bernardy Chalmers University of Technology (Sweden) Matthias Blume Google (USA) William Byrd University of Utah (USA) Andy Gill University of Kansas (USA) Neal Glew Google (USA) Fritz Henglein University of Copenhagen (Denmark) Gabriele Keller University of New South Wales and NICTA (Australia) Andrew Kennedy Microsoft Research Cambridge (UK) Neelakantan Krishnaswami Birmingham University (UK) Daan Leijen Microsoft Research Redmond (USA) Keiko Nakata Institute of Cybernetics at Tallinn University of Technology (Estonia) Mike Rainey INRIA Rocquencourt (France) Andreas Rossberg Google (Germany) Manuel Serrano INRIA Sophia Antipolis (France) Simon Thompson University of Kent (UK) David Van Horn University of Maryland (USA) Stephanie Weirich University of Pennsylvania (USA) From waldmann at imn.htwk-leipzig.de Fri Nov 7 17:44:18 2014 From: waldmann at imn.htwk-leipzig.de (Johannes Waldmann) Date: Fri, 7 Nov 2014 17:44:18 +0000 (UTC) Subject: [Haskell-cafe] why is haddock so slow References: <545CDDAA.1030908@fuuzetsu.co.uk> Message-ID: > ... running profiled Haddock executable ... how exactly do I do this? I can build haddock like this: cabal install --enable-executable-profiling haddock and then, in my project, cabal haddock --haddock-options='+RTS -p -h -RTS' results in this error: haddock: dist/build/tmp-22236/src/Inter/Wert.hs:1:14-28: You can't use Template Haskell with a profiled compiler - J.W. From p.giarrusso at gmail.com Fri Nov 7 18:00:03 2014 From: p.giarrusso at gmail.com (Paolo Giarrusso) Date: Fri, 7 Nov 2014 10:00:03 -0800 (PST) Subject: [Haskell-cafe] Fwd: Increasing Haskell modularity In-Reply-To: References: <542BFE49.6020306@gesh.uni.cx> <20867A9D-0FCE-4CB2-8156-2232366F65E1@cis.upenn.edu> <542C0FFD.6070303@gesh.uni.cx> <542C75B9.2010303@gesh.uni.cx> <20141002085018.GA2998@machine> Message-ID: <0efdd0d2-24fc-4267-8384-296ed05419b1@googlegroups.com> On Thursday, October 2, 2014 11:30:20 AM UTC+2, Dominique Devriese wrote: > > Daniel, > > This is an interesting discussion and I personally also think Haskell > should in time move away from global uniqueness of instances, at least > as the default. > > 2014-10-02 10:50 GMT+02:00 Daniel Trstenjak >: > > On Thu, Oct 02, 2014 at 12:44:25AM +0300, Gesh wrote: > >> Correct, although that's not what I said. I just said that a case could > >> be made for saying the design of programs around global uniqueness was > >> poorly thought out. > > > > I think the problem is, that for some type classes global uniqueness is > > a very good idea and for some it might not be that relevant. > > > > If there's e.g. a PrettyPrint type class, then one might argue, that > > it's a good idea to be able to change the pretty printing of a data type > > depending on the context. > > > > But for a type class represeting the equality of a data type it might be > > more harmful then good, to be able to change it. > > I think you're right that whether we want global uniqueness of > instances depends on the situation. However, it doesn't just depend on > the type class in question. > > Consider for example the Ord type class. The fact that we sometimes > want to use different orderings for the same data types is clearly > evidenced by the existence of functions such as sortBy and all of the > "comparing ..." stuff in Data.Ord. On the other hand, there is the > fact that data types like Set crucially depend on being used with a > single Ord instance for correctness. > > As you suggest, a way to deal with this could be to make a data type > like Data.Set carry around the Ord instance, something like this: > > data Set a where SomeInternalConstructor :: Ord a => ... > insert :: a -> Set a -> Set a > > However, it seems a bit unfortunate to me that this extra data (the > type class dictionary) would be carried around at runtime instead of > it being inferred and potentially compiled out at compile time. > > I wonder if a more static alternative could be to introduce some > limited form of dependent types (I'm reminded of Scala's > value-dependent types) to index the Data.Set data type with the Ord > instance that it should be used with, something like: > > > data Set a (instOrdA :: Ord a) where ... > insert :: (ordA :: Ord a, ordA ~v instOrdA) => a -> Set a instOrdA > -> Set a instOrdA > > In such code, the constraint "ordA ~v instOrdA" would require that the > two instances are equal in some intentional and decidably checkable > way (i.e. no automatic unfolding of recursive definitions and such). > Perhaps it's not even needed to require the "(ordA :: Ord a, ordA ~v > instOrdA) =>" contraint, but the compiler could somehow just take the > instance from the "Set a instOrdA" type and make it available for type > class resolution in the body of insert? > I also like this design, and it's been discussed before in the same context (http://lists.seas.upenn.edu/pipermail/types-list/2009/001412.html). I know a few ways to allow checking the constraints, but I'm not sure whether any of these fits with Haskell: - using definitional equality like in dependent types, or some encoding thereof (e.g. with empty types, as when encoding Peano numbers in the Haskell type system) - using singleton types, as in Scala (not really powerful, and does not fit with Haskell). However, Scala's relevant feature arise from making ML modules first-class and unifying them with objects. For Haskell, I'd leave out objects and get to... - use some variant of ML modules, where the modules are easier to compare because they're second-class (I wonder whether that means using singleton kinds where Scala uses singleton types). Given that the upcoming Backpack descends from a form of ML modules, this might be more relevant than is currently apparent (to me at least). Anyway, I agree with Gesh that at some point, Haskell should deprecate > global uniqueness of type class instances, but we should first explore > alternatives for modeling data types like Set that currently depend on > it. There's still quite some room for research here in my opinion. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From p.giarrusso at gmail.com Fri Nov 7 18:12:38 2014 From: p.giarrusso at gmail.com (Paolo Giarrusso) Date: Fri, 7 Nov 2014 10:12:38 -0800 (PST) Subject: [Haskell-cafe] Increasing Haskell modularity In-Reply-To: References: <20141002142106.D09F2C3827@www1.g3.pair.com> Message-ID: On Friday, October 3, 2014 1:05:36 PM UTC+2, Dominique Devriese wrote: > > 2014-10-02 16:21 GMT+02:00 Oleg >: > > However, given > > > > f2 :: Show a => a -> String > > f2 x = > > let instance Show Int where show _ = "one" > > in show x > > > > what should (f2 (1::Int)) return? > > I haven't studied this in detail (yet :)), but can't we solve this > coherence problem by requiring a bit of additional type annotations > from the programmer? Specifically, I would expect the problem to > go away if we require the user to explicitly state the resulting type > of the "let instance" expression. The syntax could look like > > let instance Show Int where show _ = "one" > in show x as Show a => String > > where the specification "Show a => String" would imply that the Show a > instance is propagated outwards and the Show Int instance is unused. > If the programmer instead wrote > > let instance Show Int where show _ = "one" > in show x as String > > That would imply that the compiler should try to resolve the required > "Show a" constraint, but I would then expect an error saying that > "Show a" cannot be derived from "Show Int", because we don't apply > unification to constraints (or at least, GHC doesn't, and it seems > like a good idea not to). > > Such an additional annotation is a bit more work for the programmer, > but perhaps that might be acceptable for this indeed sorely missed > feature? > FYI, I think that "Modular type classes" [1], Sec. 3.1, discusses what's morally the same point (in a slightly different context, since they start from ML modules). They end up rejecting the annotation overhead, arguing that it ends up being repeated each time you nest a local instance (which is an interesting technical point). However, they don't establish that the nesting is common enough for this to be a problem, hence that argument might just be very insightful handwaving, so I think it's certainly up for discussion. Quoting: Instead, we prefer [...] to put the decision under programmer control, > permitting either outcome [of the two above ones] at her [the programmer's] > discretion. We could achieve this by insisting that the scope of a using declaration > [which imports a module instance into the implicit scope] be given an > explicit signature, so that in the above example the programmer would have > to specify whether A.f is to be polymorphic or monomorphic. However, this > approach is awkward for nested using declarations, forcing repeated > specifications of the same information. > Instead we propose that the using declaration be confined to an *outer *(or > *top-level*) layer that consists only of module declarations, whose > signatures are typically specified in any case. All core-level terms appear > in the *inner *layer, where type inference proceeds without restriction, > but no using clauses are allowed. [1] Derek Dreyer, Robert Harper, Manuel M.T. Chakravarty. Modular Type Classes, POPL 2007. -------------- next part -------------- An HTML attachment was scrubbed... URL: From mail at nh2.me Fri Nov 7 18:23:16 2014 From: mail at nh2.me (=?UTF-8?B?TmlrbGFzIEhhbWLDvGNoZW4=?=) Date: Fri, 07 Nov 2014 19:23:16 +0100 Subject: [Haskell-cafe] cabal keeps relinking In-Reply-To: <20141107153549.GD64515@inanna.trygub.com> References: <20141107153549.GD64515@inanna.trygub.com> Message-ID: <545D0E14.50306@nh2.me> Which cabal version is it? If older than 1.20, this is the fix that went into 1.20: https://github.com/haskell/cabal/issues/1177 On 07/11/14 16:35, Semen Trygubenko / ????? ?????????? wrote: > cabal seems to be re-linking every time I run > cabal build From eir at cis.upenn.edu Fri Nov 7 18:40:00 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Fri, 7 Nov 2014 13:40:00 -0500 Subject: [Haskell-cafe] open-source project looking for novice help? Message-ID: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> I'm teaching an introductory Haskell course this semester (http://cis.upenn.edu/~cis194/fall14/) and am about to assign students their final project. Is there anyone out there who would welcome getting some novice help on an open-source project? You certainly don't need to commit to accept their patch(es), but I know it would be a great experience for some of the students to contribute to the "real" world of Haskell, instead of just doing exercises. You can get an accurate summary of what we've covered by looking at the lecture titles at http://cis.upenn.edu/~cis194/fall14/lectures.html Students will be choosing projects starting next week, and will need to have them completed by Dec. 15 or so. A good project is about 20 hours of work. Thanks! Richard -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewtpickering at gmail.com Fri Nov 7 19:12:42 2014 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Fri, 7 Nov 2014 19:12:42 +0000 Subject: [Haskell-cafe] open-source project looking for novice help? In-Reply-To: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> References: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> Message-ID: Pandoc has a very accessible codebase in some ways (ie it does not use advanced language features) but in other ways it is too complicated (ie the markdown reader). A student could potentially add either a reader or a writer but doing so in 20 hours would be quite ambitious. Here a few formats which I have plucked from the issue tracker: - Dokuwiki reader - WikiCreole reader (this looks quite easy) - Perl POD/Pod reader - Vimwiki reader - HTMLZ reader (quite easy) ... any other document format is also welcomed Beside that there is some internal work which needs doing - Adding support for transclusion by using a free monad to factor out effects (adding this to the txt2tags reader should be easy) Before commencing with the above I would advise posting a plan of action to the mailing list to increase the chances of getting merged. Any students are welcome to mail me if they are interested in pandoc and want to know more. On Fri, Nov 7, 2014 at 6:40 PM, Richard Eisenberg wrote: > I'm teaching an introductory Haskell course this semester > (http://cis.upenn.edu/~cis194/fall14/) and am about to assign students their > final project. Is there anyone out there who would welcome getting some > novice help on an open-source project? You certainly don't need to commit to > accept their patch(es), but I know it would be a great experience for some > of the students to contribute to the "real" world of Haskell, instead of > just doing exercises. You can get an accurate summary of what we've covered > by looking at the lecture titles at > http://cis.upenn.edu/~cis194/fall14/lectures.html > > Students will be choosing projects starting next week, and will need to have > them completed by Dec. 15 or so. A good project is about 20 hours of work. > > Thanks! > Richard > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From p.giarrusso at gmail.com Fri Nov 7 20:06:47 2014 From: p.giarrusso at gmail.com (Paolo Giarrusso) Date: Fri, 7 Nov 2014 12:06:47 -0800 (PST) Subject: [Haskell-cafe] Travis builds failing with spurious errors In-Reply-To: References: Message-ID: On Monday, November 3, 2014 4:30:05 PM UTC+1, Francesco Mazzoli wrote: > > Hi all, > > Apologies if this is not the right space to ask this question. > > We set up CI for Agda with Travis: . > > The problem is that we're having trouble with older versions of GHC. > For example, with GHC 7.4.2, the build complains that > ScopedTypeVariables is not enabled, even if it is. You can check the > build failure here: > , and the relevant > file here: < > https://github.com/agda/agda/blob/9a82afaf7657a97e85e7e31ea23f6386f99acd35/src/full/Agda/TypeChecking/Serialise.hs>. > > As you can see from the pragmas ScopedTypeVariables is enabled, and in > fact when building locally I have no problems. We also got some spurious messages regarding syntax. > > Has anybody encountered similar problems? I don't know if it's > something depending on Travis or some configuration mistakes, but I'm > a bit at loss on how to research this. Moving the OPTIONS_GHC pragma > after the LANGUAGE pragmas seems to fix the issue but I'd like to know > what's going on. Are you sure that option order is accepted by earlier GHCs? You've checked locally with the same GHC version and build process, right? Last time I had problems (crazy transient issues, seemingly unrelated), Travis people asked me to open an issue at https://github.com/travis-ci/travis-ci/issues. Everything else failing, they might let you ssh to a machine to debug the issue. They seem to be very helpful and investigate quickly (even though I have next to 0 users). A few other things I've noticed while looking around: * For what it's worth, you're not really supposed to specify patch versions (7.4.2, as opposed to 7.4) of GHC in your Travis config. However, you can probably reuse ekmett's Travis config (not sure about licenses), since it seems more flexible and installs a different GHC, maybe with a better setup (Travis seems to be short on resident Haskell experts: https://github.com/travis-ci/travis-ci/issues/2690#issuecomment-52875095) https://github.com/ekmett/lens/blob/master/.travis.yml * I've encountered something "like this", for crazy values of "like" ? as in, even stranger universe implosions on Travis for Haskell (though that looks some orthogonal setup problem): https://github.com/travis-ci/travis-ci/issues/2761 * That seems solved in later builds, but why the GHC version is changing midway here? I've found that linked in a comment from your Travis configuration. https://travis-ci.org/agda/agda/jobs/38699335#L402-L405 -------------- next part -------------- An HTML attachment was scrubbed... URL: From semen at trygub.com Fri Nov 7 20:09:29 2014 From: semen at trygub.com (Semen Trygubenko / =?utf-8?B?0KHQtdC80LXQvSDQotGA0LjQs9GD0LHQtdC9?= =?utf-8?B?0LrQvg==?=) Date: Fri, 7 Nov 2014 20:09:29 +0000 Subject: [Haskell-cafe] cabal keeps relinking In-Reply-To: <545D0E14.50306@nh2.me> References: <20141107153549.GD64515@inanna.trygub.com> <545D0E14.50306@nh2.me> Message-ID: <20141107200929.GA67778@inanna.trygub.com> On Fri, Nov 07, 2014 at 07:23:16PM +0100, Niklas Hamb?chen wrote: > Which cabal version is it? > > If older than 1.20, this is the fix that went into 1.20: > https://github.com/haskell/cabal/issues/1177 $ cabal --version cabal-install version 1.20.0.3 using version 1.20.0.2 of the Cabal library -- ????? ?????????? http://trygub.com -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 181 bytes Desc: not available URL: From mail at nh2.me Fri Nov 7 21:16:31 2014 From: mail at nh2.me (=?UTF-8?B?TmlrbGFzIEhhbWLDvGNoZW4=?=) Date: Fri, 07 Nov 2014 22:16:31 +0100 Subject: [Haskell-cafe] cabal keeps relinking In-Reply-To: <20141107200929.GA67778@inanna.trygub.com> References: <20141107153549.GD64515@inanna.trygub.com> <545D0E14.50306@nh2.me> <20141107200929.GA67778@inanna.trygub.com> Message-ID: <545D36AF.2090208@nh2.me> Could you detail how cabal relinks for you, e.g. with some cabal -v2 / -v3 output? On 07/11/14 21:09, Semen Trygubenko / ????? ?????????? wrote: > On Fri, Nov 07, 2014 at 07:23:16PM +0100, Niklas Hamb?chen wrote: >> Which cabal version is it? >> >> If older than 1.20, this is the fix that went into 1.20: >> https://github.com/haskell/cabal/issues/1177 > > $ cabal --version cabal-install version 1.20.0.3 using version > 1.20.0.2 of the Cabal library > > > From fuuzetsu at fuuzetsu.co.uk Fri Nov 7 23:48:33 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Fri, 07 Nov 2014 23:48:33 +0000 Subject: [Haskell-cafe] why is haddock so slow In-Reply-To: References: <545CDDAA.1030908@fuuzetsu.co.uk> Message-ID: <545D5A51.50906@fuuzetsu.co.uk> On 11/07/2014 05:44 PM, Johannes Waldmann wrote: > >> ... running profiled Haddock executable ... > > how exactly do I do this? I can build haddock like this: > > cabal install --enable-executable-profiling haddock > > and then, in my project, > > cabal haddock --haddock-options='+RTS -p -h -RTS' > > results in this error: > > haddock: dist/build/tmp-22236/src/Inter/Wert.hs:1:14-28: You can't use > Template Haskell with a profiled compiler > > - J.W. > Ah, unfortunately it is what it says, you can't use TH in this scenario. There is a workaround at https://www.haskell.org/ghc/docs/7.8.3/html/users_guide/template-haskell.html, section 7.16.4, maybe it will work for you. If it's possible to temporarily disable the TH in question (stick undefined in place) then that might be easier although I don't expect that's easily achievable, I think you mentioned ~800 modules. -- Mateusz K. From fuuzetsu at fuuzetsu.co.uk Sat Nov 8 11:31:24 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Sat, 08 Nov 2014 11:31:24 +0000 Subject: [Haskell-cafe] open-source project looking for novice help? In-Reply-To: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> References: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> Message-ID: <545DFF0C.3040702@fuuzetsu.co.uk> On 11/07/2014 06:40 PM, Richard Eisenberg wrote: > I'm teaching an introductory Haskell course this semester > (http://cis.upenn.edu/~cis194/fall14/) and am about to assign > students their final project. Is there anyone out there who would > welcome getting some novice help on an open-source project? You > certainly don't need to commit to accept their patch(es), but I know > it would be a great experience for some of the students to contribute > to the "real" world of Haskell, instead of just doing exercises. You > can get an accurate summary of what we've covered by looking at the > lecture titles at http://cis.upenn.edu/~cis194/fall14/lectures.html > > > Students will be choosing projects starting next week, and will need > to have them completed by Dec. 15 or so. A good project is about 20 > hours of work. > > Thanks! Richard > I'd love to snatch a helper for something but I think most of what one would consider ?serious? projects would take a bit more than 20 hours: I'd welcome some patches for Yi, Haddock or even some dabbling in GHC's lexer/parser if you have an ambitious student who wants to get involved further ;). Alas, that's probably not the kind of scope you're after. For something a bit easier, I can suggest two projects which offer multiple sub-projects: * [1] is a front-end to tesseract[2] OCR software. Possible work involves improving the interface (hey, I'm a programmer not a designer?), adding features such as on-the-fly translation through Bing or another service (this seems like a nice little project, you end up with a lib to talk to the service even if they don't get to integrate it), add support for history (probably not enough for a project by itself) or if the student is more ambitious, automatic region detection as boasted by the (proprietary) software KanjiTomo[3]. So there's talking to the service, messing around with a GUI (gtk2hs) or work with images/pattern recognition (I can only help with Haskell side here). The plus side is that the existing code is pretty primitive if they choose to do something with the GUI, no 7-layer deep monad transformers. * free-game[4] is a game library but it is pretty small in what it offers: you get some basic stuff but it's not a full-blown suite. A project could involve writing useful libraries around it, I could come up with some specifics if there's interest. I can't offer help with hacking on free-game itself but I wouldn't mind overseeing any libs that spawn around it. * EDIT just before sending: For a while now I have quite an annoyance with criterion; it produces those pretty HTML + JS graphs you can mouse-over and stuff, right? The problem is that they are absolutely useless to the point of hanging your browser if you have more than a few benchmarks on the page. I think a nice project would be developing a reporting package with ?diagrams? or something which takes Criterion's output (CSV) and spits outs images we can actually inspect. This seems like something a student can get on with pretty easily and take it as far as they wish while having practical value at the same time. I wish I could offer more ideas but it's hard to come up with something that will fit into 20 hours including getting the feel for things and that might be interesting to the student, have some value to the rest of us and doesn't feel like an exercise. I am a big fan of ?learn by actually hacking stuff? approach, just not in such a (relatively) small timescale ;). I don't mind overseeing someone if they happen to pick anything I mentioned here (with the exception of GHC itself) or something that interests me. I don't mind volunteering as ?overseer? for some other project if the student is willing and is likely to join the community for longer. [1]: https://github.com/Fuuzetsu/tsuntsun [2]: http://code.google.com/p/tesseract-ocr/ [3]: http://kanjitomo.net/ [4]: http://hackage.haskell.org/package/free-game -- Mateusz K. From anon13670 at gmail.com Sat Nov 8 15:04:28 2014 From: anon13670 at gmail.com (Anon 2014) Date: Sat, 8 Nov 2014 10:04:28 -0500 Subject: [Haskell-cafe] open-source project looking for novice help? In-Reply-To: <545DFF0C.3040702@fuuzetsu.co.uk> References: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> <545DFF0C.3040702@fuuzetsu.co.uk> Message-ID: <003401cffb65$4b87e6a0$e297b3e0$@gmail.com> One suggestion is to write a paper on how to create a simple hybrid mobile app in Haskell. Just basic functionality like take a picture from a mobile device, geotag it and store it on the server. Fullstack toolset to write hybrid mobile apps similar to the below project https://github.com/mtolly/hs-cordova -----Original Message----- From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Mateusz Kowalczyk Sent: Saturday, November 8, 2014 6:31 AM To: haskell-cafe at haskell.org Subject: Re: [Haskell-cafe] open-source project looking for novice help? On 11/07/2014 06:40 PM, Richard Eisenberg wrote: > I'm teaching an introductory Haskell course this semester > (http://cis.upenn.edu/~cis194/fall14/) and am about to assign students > their final project. Is there anyone out there who would welcome > getting some novice help on an open-source project? You certainly > don't need to commit to accept their patch(es), but I know it would be > a great experience for some of the students to contribute to the > "real" world of Haskell, instead of just doing exercises. You can get > an accurate summary of what we've covered by looking at the lecture > titles at http://cis.upenn.edu/~cis194/fall14/lectures.html > > > Students will be choosing projects starting next week, and will need > to have them completed by Dec. 15 or so. A good project is about 20 > hours of work. > > Thanks! Richard > I'd love to snatch a helper for something but I think most of what one would consider 'serious' projects would take a bit more than 20 hours: I'd welcome some patches for Yi, Haddock or even some dabbling in GHC's lexer/parser if you have an ambitious student who wants to get involved further ;). Alas, that's probably not the kind of scope you're after. For something a bit easier, I can suggest two projects which offer multiple sub-projects: * [1] is a front-end to tesseract[2] OCR software. Possible work involves improving the interface (hey, I'm a programmer not a designer.), adding features such as on-the-fly translation through Bing or another service (this seems like a nice little project, you end up with a lib to talk to the service even if they don't get to integrate it), add support for history (probably not enough for a project by itself) or if the student is more ambitious, automatic region detection as boasted by the (proprietary) software KanjiTomo[3]. So there's talking to the service, messing around with a GUI (gtk2hs) or work with images/pattern recognition (I can only help with Haskell side here). The plus side is that the existing code is pretty primitive if they choose to do something with the GUI, no 7-layer deep monad transformers. * free-game[4] is a game library but it is pretty small in what it offers: you get some basic stuff but it's not a full-blown suite. A project could involve writing useful libraries around it, I could come up with some specifics if there's interest. I can't offer help with hacking on free-game itself but I wouldn't mind overseeing any libs that spawn around it. * EDIT just before sending: For a while now I have quite an annoyance with criterion; it produces those pretty HTML + JS graphs you can mouse-over and stuff, right? The problem is that they are absolutely useless to the point of hanging your browser if you have more than a few benchmarks on the page. I think a nice project would be developing a reporting package with 'diagrams' or something which takes Criterion's output (CSV) and spits outs images we can actually inspect. This seems like something a student can get on with pretty easily and take it as far as they wish while having practical value at the same time. I wish I could offer more ideas but it's hard to come up with something that will fit into 20 hours including getting the feel for things and that might be interesting to the student, have some value to the rest of us and doesn't feel like an exercise. I am a big fan of 'learn by actually hacking stuff' approach, just not in such a (relatively) small timescale ;). I don't mind overseeing someone if they happen to pick anything I mentioned here (with the exception of GHC itself) or something that interests me. I don't mind volunteering as 'overseer' for some other project if the student is willing and is likely to join the community for longer. [1]: https://github.com/Fuuzetsu/tsuntsun [2]: http://code.google.com/p/tesseract-ocr/ [3]: http://kanjitomo.net/ [4]: http://hackage.haskell.org/package/free-game -- Mateusz K. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe at haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe From omeragacan at gmail.com Sat Nov 8 15:39:51 2014 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Sat, 8 Nov 2014 17:39:51 +0200 Subject: [Haskell-cafe] `cabal repl` problems Message-ID: Hi all, I have a Cabal project that has library, executable and several test parts. I'd like to be able to load one of the test parts into GHCi using `cabal repl`. However, I'm having some problems: (To be more specific, I have these parts in my Cabal file: - library - executable myapp - test-suite test - test-suite doctests) - `cabal repl test` tries to load test suite into GHCi but it doesn't ask me which test suite I want to load. For example, in my Cabal file I have `test-suite test` and `test-suite doctests`. `cabal test doctests` runs only doctests but I can't use similar command for repl, like `cabal repl doctests`. - `cabal repl test` tries to load the library, but using wrong set of dependencies. It uses `build-depends` field of `test-suite test` but it loads `library` sources. Note that `hs-source-dirs` field of `test-suite test` and `library` are different, and I have my library in `test-suite test` as a dependency. So the problem is that it tries to load `library` part using the source, instead of compiled lib. Any ideas about those? (Note: `cabal test`, `cabal install`, `cabal run` etc. work fine, my Cabal file is working) Thanks. From oleksandr.petrov at gmail.com Sat Nov 8 15:54:06 2014 From: oleksandr.petrov at gmail.com (Alex Petrov) Date: Sat, 8 Nov 2014 16:54:06 +0100 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial Message-ID: Hi Everyone, I've recently started working on Haskell FFI Tutorial [1]. The repository already? contains code that explains how to: ? * (expressively) represent C `struct` in Haskell code ? * call C code from Haskell ? * call Haskell code from C ? * operate on nested `struct`s? ? * operate on `struct` arrays ? * decode `unions`? ? * read and write C fixed-length strings and Pointer-type Strings ? * how to import functions from, for example, stdlib I'm still working on more story-like writeups, but the first one (about how to call Haskell? from C) is already available [2]. If you have any feedback / comments / questions, know how to improve it or? would like to see more things covered, just ping me.? Thanks [1]?https://github.com/ifesdjeen/haskell-ffi-tutorial [2]?https://github.com/ifesdjeen/haskell-ffi-tutorial#calling-haskell-from-c --? Alex https://twitter.com/ifesdjeen http://clojurewerkz.org/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From sol at typeful.net Sat Nov 8 16:01:22 2014 From: sol at typeful.net (Simon Hengel) Date: Sun, 9 Nov 2014 00:01:22 +0800 Subject: [Haskell-cafe] `cabal repl` problems In-Reply-To: References: Message-ID: <20141108160122.GA31303@x200> Hi, > Any ideas about those? If your main objective is to use the package database from a sandbox, you may find `cabal exec` in combination with a project specific .ghci file a more viable option. Here is an example: $ echo :set -isrc -itest > .ghci $ chmod go-w .ghci $ cabal exec ghci test/Spec.hs Cheers, Simon From cpdurham at gmail.com Sat Nov 8 17:06:53 2014 From: cpdurham at gmail.com (Charlie Durham) Date: Sat, 8 Nov 2014 12:06:53 -0500 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: I just built an FFI Interface for a camera in C++ called from Haskell, it would be nice to see an interface done for C++ with objects. I got it working pretty quickly searching around from other sites, but it would be cool if it was all in one place. Sort of off topic, I had an issue where the main in C++ ran perfectly fine calling into what I believe to be a singleton, but calling from Haskell led to that call freezing every time. If I put the call to the singleton into a static block, it runs fine calling from Haskell. Is this probably the "Static order initialization fiasco"? Charlie On Sat, Nov 8, 2014 at 10:54 AM, Alex Petrov wrote: > Hi Everyone, > > I've recently started working on Haskell FFI Tutorial [1]. The repository > already > contains code that explains how to: > > * (expressively) represent C `struct` in Haskell code > * call C code from Haskell > * call Haskell code from C > * operate on nested `struct`s > * operate on `struct` arrays > * decode `unions` > * read and write C fixed-length strings and Pointer-type Strings > * how to import functions from, for example, stdlib > > I'm still working on more story-like writeups, but the first one (about > how to call Haskell > from C) is already available [2]. > > If you have any feedback / comments / questions, know how to improve it or > would like to see more things covered, just ping me. > > Thanks > > [1] https://github.com/ifesdjeen/haskell-ffi-tutorial > [2] > https://github.com/ifesdjeen/haskell-ffi-tutorial#calling-haskell-from-c > > > -- > > > Alex > https://twitter.com/ifesdjeen > > http://clojurewerkz.org/ > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From omeragacan at gmail.com Sat Nov 8 17:14:52 2014 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Sat, 8 Nov 2014 19:14:52 +0200 Subject: [Haskell-cafe] `cabal repl` problems In-Reply-To: <20141108160122.GA31303@x200> References: <20141108160122.GA31303@x200> Message-ID: > Here is an example: > > $ echo :set -isrc -itest > .ghci > $ chmod go-w .ghci > $ cabal exec ghci test/Spec.hs Thanks Simon, something like that worked. From rdockins at galois.com Sun Nov 9 00:26:13 2014 From: rdockins at galois.com (Rob) Date: Sat, 08 Nov 2014 16:26:13 -0800 Subject: [Haskell-cafe] Extensionality principles for kinds? Message-ID: <545EB4A5.5000007@galois.com> Haskellers, I've waded into some pretty deep waters, but I'm hoping there's a GHC type system wizard in here who can help me. The following code fragment is extracted from something I've been working on involving some pretty fancy type-level programming. I'm using GHC 7.8.3. I've run into a problem where the typechecker refuses to believe that two types are equal; it seems to lack the necessary extensionality principles for lifted data kinds. Basically (see below for definitions) I get into a contex where I know that (TwiceLeft a ~ TwiceLeft b) and (TwiceRight a ~ TwiceRight b), but the typechecker will not believe that (a ~ b). Are there any tricks I can employ to make this code typecheck (using only safe operations)? Bonus if it doesn't add any runtime cost. Thanks, Rob Dockins ====== code follows ====== {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} import Data.Type.Equality -- lifted kind (Twice k) consists of a pair of things of kind k data Twice k = TwiceVal k k -- type family accessor functions for the Twice kind type family TwiceLeft (x::Twice k) :: k where TwiceLeft (TwiceVal a b) = a type family TwiceRight (x::Twice k) :: k where TwiceRight (TwiceVal a b) = b -- Double is already taken, use Dbl instead... data Dbl (f :: k -> *) (tv :: Twice k) = Dbl (f (TwiceLeft tv)) (f (TwiceRight tv)) -- This function doesn't typecheck... doubleEq :: forall (f:: k -> *) . (forall (a::k) (b::k). f a -> f b -> Maybe (a :~: b)) -> (forall (a::Twice k) (b::Twice k). Dbl f a -> Dbl f b -> Maybe (a :~: b)) doubleEq teq (Dbl x y) (Dbl z w) = case teq x z of Nothing -> Nothing Just Refl -> case teq y w of Nothing -> Nothing Just Refl -> Just Refl From eir at cis.upenn.edu Sun Nov 9 03:30:12 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sat, 8 Nov 2014 22:30:12 -0500 Subject: [Haskell-cafe] Extensionality principles for kinds? In-Reply-To: <545EB4A5.5000007@galois.com> References: <545EB4A5.5000007@galois.com> Message-ID: <6CB1A44B-F9C3-4D72-93A7-1B91F6F6746D@cis.upenn.edu> The problem is that GHC doesn't do eta expansion for product types. See #7259, which won't be fixed by 7.10, as I would imagine a fair amount of theory needs to be done for this to be valid. Luckily, you can do eta expansion manually yourself: either by requiring that the caller know the eta-expanded form (1) or by storing that knowledge in a GADT (2): (1): Change the type signature of doubleEq to > doubleEq :: (forall a b. f a -> f b -> Maybe (a :~: b)) > -> Dbl f (TwiceVal a1 a2) > -> Dbl f (TwiceVal b1 b2) > -> Maybe (TwiceVal a1 a2 :~: TwiceVal b1 b2) Here, I've dumped the unnecessary `forall`s (for my own sanity) and simply eta-expanded `a` and `b`. With this type, the original implementation of `doubleEq` type checks. (2): Learn about the eta-expansion via a GADT pattern-match by changing `Dbl` to this: > data Dbl (f :: k -> *) (tv :: Twice k) where > Dbl :: f a -> f b -> Dbl f (TwiceVal a b) With this definition, when you pattern-match on the constructor `Dbl`, you also learn that `tv` really must be a `TwiceVal`. Then, the original type and definition for `doubleEq` type-check. The trade-off between (1) and (2) is where the caller needs to know about the eta-expansions: in (1), it's the caller of `doubleEq` that must know it's passing in a real `TwiceVal`. In (2), it's the caller of the `Dbl` constructor that must know. I rather favor (2), as it allows you to pass the expansion knowledge around quite easily, and you don't need the `TwiceLeft` and `TwiceRight` type families. Note that you need only solution (1) or (2), not both. (Though both works, too.) I hope this helps! Richard On Nov 8, 2014, at 7:26 PM, Rob wrote: > Haskellers, > > I've waded into some pretty deep waters, but I'm hoping there's a GHC type system wizard in here who can help me. The following code fragment is extracted from something I've been working on involving some pretty fancy type-level programming. I'm using GHC 7.8.3. > > I've run into a problem where the typechecker refuses to believe that two types are equal; it seems to lack the necessary extensionality principles for lifted data kinds. Basically (see below for definitions) I get into a contex where I know that (TwiceLeft a ~ TwiceLeft b) and (TwiceRight a ~ TwiceRight b), but the typechecker will not believe that (a ~ b). > > Are there any tricks I can employ to make this code typecheck (using only safe operations)? Bonus if it doesn't add any runtime cost. > > Thanks, > Rob Dockins > > > ====== code follows ====== > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE PolyKinds #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE TypeFamilies #-} > > import Data.Type.Equality > > -- lifted kind (Twice k) consists of a pair of things of kind k > data Twice k = TwiceVal k k > > -- type family accessor functions for the Twice kind > type family TwiceLeft (x::Twice k) :: k where > TwiceLeft (TwiceVal a b) = a > > type family TwiceRight (x::Twice k) :: k where > TwiceRight (TwiceVal a b) = b > > -- Double is already taken, use Dbl instead... > data Dbl (f :: k -> *) (tv :: Twice k) = Dbl (f (TwiceLeft tv)) (f (TwiceRight tv)) > > -- This function doesn't typecheck... > doubleEq :: forall (f:: k -> *) > . (forall (a::k) (b::k). f a -> f b -> Maybe (a :~: b)) > -> (forall (a::Twice k) (b::Twice k). Dbl f a -> Dbl f b -> Maybe (a :~: b)) > doubleEq teq (Dbl x y) (Dbl z w) = > case teq x z of > Nothing -> Nothing > Just Refl -> > case teq y w of > Nothing -> Nothing > Just Refl -> Just Refl > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From rdockins at galois.com Sun Nov 9 06:29:51 2014 From: rdockins at galois.com (Rob) Date: Sat, 08 Nov 2014 22:29:51 -0800 Subject: [Haskell-cafe] Extensionality principles for kinds? In-Reply-To: <6CB1A44B-F9C3-4D72-93A7-1B91F6F6746D@cis.upenn.edu> References: <545EB4A5.5000007@galois.com> <6CB1A44B-F9C3-4D72-93A7-1B91F6F6746D@cis.upenn.edu> Message-ID: <545F09DF.5020405@galois.com> On 11/08/2014 07:30 PM, Richard Eisenberg wrote: > The problem is that GHC doesn't do eta expansion for product types. See #7259, which won't be fixed by 7.10, as I would imagine a fair amount of theory needs to be done for this to be valid. > > Luckily, you can do eta expansion manually yourself: either by requiring that the caller know the eta-expanded form (1) or by storing that knowledge in a GADT (2): I was afraid that would be the answer. Unfortunately, I think I really need the non-eta-expanded form, because either of the eta forms you suggest break other things. The problem is that Twice and Dbl occur in some definitions that go by polymorphic recursion, an the eta-expanded forms don't seem to work. I'll see if I can get by without this... Cheers, Rob From omeragacan at gmail.com Sun Nov 9 12:08:20 2014 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Sun, 9 Nov 2014 14:08:20 +0200 Subject: [Haskell-cafe] IO and exceptions Message-ID: Hi all, I'm having some trouble with IO functions and exceptions. When I call an IO function in Haskell, I feel very uncomfortable, because you never know what kind of exceptions your function may throw. There are a lot of cases where thrown exceptions are not specified in the documentation. What's worse, there are cases where it's impossible to catch thrown exceptions in a safe way. Example to not knowing what exceptions may be thrown: http://hackage.haskell.org/package/base-4.6.0.1/docs/Control-Concurrent-Chan.html `readChan` blocks the thread until it reads something. But what happens when channel is closed while one thread is blocked to read? It's not mentioned in the documentation and it's not specified in terms of types. (e.g. by using Either, Maybe or similar) Example to not being able to catch the exception: http://hackage.haskell.org/package/network-2.6.0.2/docs/Network-Socket.html `recvFrom` blocks the thread until it reads something. However, what happens if socket is closed while `recvFrom` is blocking to read? Similar to `readChan`, we can't know this. What's worse is this: sockets have a `SO_RCVTIMEO` option, a timeout value for `recv_from` calls. What happens when we set that using `setSocketOption` in the same module and call `recvFrom` is unknown. This is really horrible, because a timeout exception is really something that you'd like to catch. Example: I have a thread that listens from a socket and handles some other events. I want to stop listening the socket after every second and handle events, then return listening the socket. But I can't know what it throws when timeout happens, so I have to catch all exceptions, which is horrible for a lot of reasons. I was wondering if I'm doing something wrong. I'm sure we can find a lot of cases like these and I feel like libraries are not designed very good for errors/exceptions. So I'd like to get some ideas/suggestions about this. Am I doing something wrong or did I misunderstand something? Should we improve the libraries for better types/error handling? Am I only one here that has problems with those functions? Thanks. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Nov 9 12:22:12 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 9 Nov 2014 12:22:12 +0000 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: References: Message-ID: <20141109122212.GE26786@weber> On Sun, Nov 09, 2014 at 02:08:20PM +0200, ?mer Sinan A?acan wrote: > Am I only one here that has problems with those functions? By no means. I am also very uncomfortable with exceptions that are not visible in types. From roma at ro-che.info Sun Nov 9 13:11:41 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sun, 09 Nov 2014 08:11:41 -0500 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: References: Message-ID: <545F680D.50708@ro-che.info> Let's say you knew what exceptions could be thrown. What would you do differently then? Typically, if it's a command-line app and something unexpected happens, you simply present the error to the user. That's what exceptions do already without any effort from you. If it's a server app, you catch exceptions at a certain point, log them, maybe give some feedback to the client and proceed with the other requests. In order to do that, you don't really need to know the set of all possible exceptions. > `readChan` blocks the thread until it reads something. But what > happens when channel is closed while one thread is blocked to read? What do you mean by "channel is closed"? Channels don't get closed; there's no function to do that. It's possible that your blocked thread has the only remaining reference to the channel; in that case, the deadlock may (or may not) be detected, and an exception will be thrown in the former case. > Example to not being able to catch the exception: > http://hackage.haskell.org/package/network-2.6.0.2/docs/Network-Socket.html > `recvFrom` blocks the thread until it reads something. However, what > happens if socket is closed while `recvFrom` is blocking to read? > Similar to `readChan`, we can't know this. What's worse is this: > sockets have a `SO_RCVTIMEO` option, a timeout value for `recv_from` > calls. What happens when we set that using `setSocketOption` in the > same module and call `recvFrom` is unknown. This is really horrible, > because a timeout exception is really something that you'd like to > catch. Example: I have a thread that listens from a socket and handles > some other events. I want to stop listening the socket after every > second and handle events, then return listening the socket. But I > can't know what it throws when timeout happens, so I have to catch all > exceptions, which is horrible for a lot of reasons. It sounds like you're trying to write C-style in Haskell, which is probably not the best way to do it. More Haskelly way would be to: 1. Use Network instead of Network.Socket and take advantage of GHC's IO manager. That means that you'll be using something like epoll instead of recvfrom under the hood. 2. Instead of manually multiplexing several things into one thread (listening on the socket and "handling some other events"), do that in different threads. 3. If you do need a timeout (not for multiplexing, but for a genuine timeout), use System.Timeout. Roman From agocorona at gmail.com Sun Nov 9 13:20:07 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Sun, 9 Nov 2014 14:20:07 +0100 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: <545F680D.50708@ro-che.info> References: <545F680D.50708@ro-che.info> Message-ID: In the other side, this package does exactly what you want (I think). 2014-11-09 14:11 GMT+01:00 Roman Cheplyaka : > Let's say you knew what exceptions could be thrown. What would you do > differently then? > > Typically, if it's a command-line app and something unexpected happens, > you simply present the error to the user. That's what exceptions do > already without any effort from you. > > If it's a server app, you catch exceptions at a certain point, log them, > maybe give some feedback to the client and proceed with the other > requests. In order to do that, you don't really need to know the set of > all possible exceptions. > > > `readChan` blocks the thread until it reads something. But what > > happens when channel is closed while one thread is blocked to read? > > What do you mean by "channel is closed"? Channels don't get closed; > there's no function to do that. > > It's possible that your blocked thread has the only remaining reference > to the channel; in that case, the deadlock may (or may not) be detected, > and an exception will be thrown in the former case. > > > Example to not being able to catch the exception: > > > http://hackage.haskell.org/package/network-2.6.0.2/docs/Network-Socket.html > > `recvFrom` blocks the thread until it reads something. However, what > > happens if socket is closed while `recvFrom` is blocking to read? > > Similar to `readChan`, we can't know this. What's worse is this: > > sockets have a `SO_RCVTIMEO` option, a timeout value for `recv_from` > > calls. What happens when we set that using `setSocketOption` in the > > same module and call `recvFrom` is unknown. This is really horrible, > > because a timeout exception is really something that you'd like to > > catch. Example: I have a thread that listens from a socket and handles > > some other events. I want to stop listening the socket after every > > second and handle events, then return listening the socket. But I > > can't know what it throws when timeout happens, so I have to catch all > > exceptions, which is horrible for a lot of reasons. > > It sounds like you're trying to write C-style in Haskell, which is > probably not the best way to do it. > > More Haskelly way would be to: > > 1. Use Network instead of Network.Socket and take advantage of GHC's IO > manager. That means that you'll be using something like epoll instead of > recvfrom under the hood. > 2. Instead of manually multiplexing several things into one thread > (listening on the socket and "handling some other events"), do that in > different threads. > 3. If you do need a timeout (not for multiplexing, but for a genuine > timeout), use System.Timeout. > > > Roman > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From agocorona at gmail.com Sun Nov 9 13:20:40 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Sun, 9 Nov 2014 14:20:40 +0100 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: References: <545F680D.50708@ro-che.info> Message-ID: This one: https://hackage.haskell.org/package/control-monad-exception 2014-11-09 14:20 GMT+01:00 Alberto G. Corona : > In the other side, this package does exactly what you want (I think). > > > 2014-11-09 14:11 GMT+01:00 Roman Cheplyaka : > >> Let's say you knew what exceptions could be thrown. What would you do >> differently then? >> >> Typically, if it's a command-line app and something unexpected happens, >> you simply present the error to the user. That's what exceptions do >> already without any effort from you. >> >> If it's a server app, you catch exceptions at a certain point, log them, >> maybe give some feedback to the client and proceed with the other >> requests. In order to do that, you don't really need to know the set of >> all possible exceptions. >> >> > `readChan` blocks the thread until it reads something. But what >> > happens when channel is closed while one thread is blocked to read? >> >> What do you mean by "channel is closed"? Channels don't get closed; >> there's no function to do that. >> >> It's possible that your blocked thread has the only remaining reference >> to the channel; in that case, the deadlock may (or may not) be detected, >> and an exception will be thrown in the former case. >> >> > Example to not being able to catch the exception: >> > >> http://hackage.haskell.org/package/network-2.6.0.2/docs/Network-Socket.html >> > `recvFrom` blocks the thread until it reads something. However, what >> > happens if socket is closed while `recvFrom` is blocking to read? >> > Similar to `readChan`, we can't know this. What's worse is this: >> > sockets have a `SO_RCVTIMEO` option, a timeout value for `recv_from` >> > calls. What happens when we set that using `setSocketOption` in the >> > same module and call `recvFrom` is unknown. This is really horrible, >> > because a timeout exception is really something that you'd like to >> > catch. Example: I have a thread that listens from a socket and handles >> > some other events. I want to stop listening the socket after every >> > second and handle events, then return listening the socket. But I >> > can't know what it throws when timeout happens, so I have to catch all >> > exceptions, which is horrible for a lot of reasons. >> >> It sounds like you're trying to write C-style in Haskell, which is >> probably not the best way to do it. >> >> More Haskelly way would be to: >> >> 1. Use Network instead of Network.Socket and take advantage of GHC's IO >> manager. That means that you'll be using something like epoll instead of >> recvfrom under the hood. >> 2. Instead of manually multiplexing several things into one thread >> (listening on the socket and "handling some other events"), do that in >> different threads. >> 3. If you do need a timeout (not for multiplexing, but for a genuine >> timeout), use System.Timeout. >> >> >> Roman >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > > -- > Alberto. > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at orlitzky.com Sun Nov 9 13:38:02 2014 From: michael at orlitzky.com (Michael Orlitzky) Date: Sun, 09 Nov 2014 08:38:02 -0500 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: <545F680D.50708@ro-che.info> References: <545F680D.50708@ro-che.info> Message-ID: <545F6E3A.7010303@orlitzky.com> On 11/09/2014 08:11 AM, Roman Cheplyaka wrote: > Let's say you knew what exceptions could be thrown. What would you do > differently then? > > Typically, if it's a command-line app and something unexpected happens, > you simply present the error to the user. That's what exceptions do > already without any effort from you. > The output from the exception is usually useless, though. Rather than, *** Exception: EACCES (or something similar, whatever, I'm making it up), I want to show: Insufficient permissions for accessing /run/. This can be fixed by granting write and execute access on that directory to the user under which the application is running. If the operation can fail in different ways -- like if the directory is missing entirely -- I need to pattern match on the exception and display something else. Another example: I don't want to log a "read error" in my daemon, which is what I'll get if I log the exception. I want to know *what* failed to be read. Was it a file (that a cron job deleted) or a network socket (whose connection was dropped)? I need to catch those in the code, where I know what's being read, and what the "read error" means in context. From roma at ro-che.info Sun Nov 9 13:53:25 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sun, 09 Nov 2014 08:53:25 -0500 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: <545F6E3A.7010303@orlitzky.com> References: <545F680D.50708@ro-che.info> <545F6E3A.7010303@orlitzky.com> Message-ID: <545F71D5.9060906@ro-che.info> On 09/11/14 08:38, Michael Orlitzky wrote: > On 11/09/2014 08:11 AM, Roman Cheplyaka wrote: >> Let's say you knew what exceptions could be thrown. What would you do >> differently then? >> >> Typically, if it's a command-line app and something unexpected happens, >> you simply present the error to the user. That's what exceptions do >> already without any effort from you. >> > > The output from the exception is usually useless, though. Rather than, > > *** Exception: EACCES > > (or something similar, whatever, I'm making it up), I want to show: > > Insufficient permissions for accessing /run/. This can be fixed > by granting write and execute access on that directory to the user > under which the application is running. > > If the operation can fail in different ways -- like if the directory is > missing entirely -- I need to pattern match on the exception and display > something else. > > Another example: I don't want to log a "read error" in my daemon, which > is what I'll get if I log the exception. I want to know *what* failed to > be read. Was it a file (that a cron job deleted) or a network socket > (whose connection was dropped)? I need to catch those in the code, where > I know what's being read, and what the "read error" means in context. Both points are valid. Re the first, you still can achieve it by pattern-matching on exceptions. The fact that you don't know the exact set of exceptions makes it harder, but the truth is, for a non-trivial application, that set would be huge. Like, let's say you use a database. It brings in all sorts of network-related exceptions and database-level exceptions. The way to handle those, as you point out, is to augment them with high-level information ("Could not retrieve user's data"), and then maybe attach the low-level exception for debugging purposes. Again, you don't really need to know the whole set of exceptions in order to do that. Just wrap your database access function in 'try', and you'll know that whatever exception was caught, it prevented the retrieval of user's data (but keep in mind that it might be an asynchronous exception unrelated to your database activity). Roman From mantkiew at gsd.uwaterloo.ca Sun Nov 9 15:01:18 2014 From: mantkiew at gsd.uwaterloo.ca (Michal Antkiewicz) Date: Sun, 9 Nov 2014 10:01:18 -0500 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: <545F71D5.9060906@ro-che.info> References: <545F680D.50708@ro-che.info> <545F6E3A.7010303@orlitzky.com> <545F71D5.9060906@ro-che.info> Message-ID: Whether thrown exceptions should be explicitly part of interface or not is still an open issue. For example, Java requires to explicitly declare the exception as part of method signature. And people complained... Then in Scala, for example, there's no such requirement. I've seen a paper showing negative consequences of implicit exceptions but I cannot find it now (I thought it was ICSE 2014...). I found some other paper contrasting implicit vs. explicit exception flows. http://www.les.inf.puc-rio.br/opus/docs/pubs/2009/10_NelioCacho-SBES2009.pdf So, sometimes you need to handle the exception at the call site but if it's required that people simply "swallow" the exception (catch and do nothing), sometimes you need to handle them centrally in some way. I'm not sure what is best for Haskell. Michal On Sun, Nov 9, 2014 at 8:53 AM, Roman Cheplyaka wrote: > On 09/11/14 08:38, Michael Orlitzky wrote: > > On 11/09/2014 08:11 AM, Roman Cheplyaka wrote: > >> Let's say you knew what exceptions could be thrown. What would you do > >> differently then? > >> > >> Typically, if it's a command-line app and something unexpected happens, > >> you simply present the error to the user. That's what exceptions do > >> already without any effort from you. > >> > > > > The output from the exception is usually useless, though. Rather than, > > > > *** Exception: EACCES > > > > (or something similar, whatever, I'm making it up), I want to show: > > > > Insufficient permissions for accessing /run/. This can be fixed > > by granting write and execute access on that directory to the user > > under which the application is running. > > > > If the operation can fail in different ways -- like if the directory is > > missing entirely -- I need to pattern match on the exception and display > > something else. > > > > Another example: I don't want to log a "read error" in my daemon, which > > is what I'll get if I log the exception. I want to know *what* failed to > > be read. Was it a file (that a cron job deleted) or a network socket > > (whose connection was dropped)? I need to catch those in the code, where > > I know what's being read, and what the "read error" means in context. > > Both points are valid. > > Re the first, you still can achieve it by pattern-matching on > exceptions. The fact that you don't know the exact set of exceptions > makes it harder, but the truth is, for a non-trivial application, that > set would be huge. Like, let's say you use a database. It brings in all > sorts of network-related exceptions and database-level exceptions. > > The way to handle those, as you point out, is to augment them with > high-level information ("Could not retrieve user's data"), and then > maybe attach the low-level exception for debugging purposes. Again, you > don't really need to know the whole set of exceptions in order to do > that. Just wrap your database access function in 'try', and you'll know > that whatever exception was caught, it prevented the retrieval of user's > data (but keep in mind that it might be an asynchronous exception > unrelated to your database activity). > > Roman > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Sun Nov 9 16:38:26 2014 From: r.wobben at home.nl (Roelof Wobben) Date: Sun, 09 Nov 2014 17:38:26 +0100 Subject: [Haskell-cafe] xs not in scope Message-ID: <545F9882.6080806@home.nl> Hello, Im trying to find several answers to problem1 of the 99 haskell problems. Find the last item in a list. Now im trying to find a guarded solution. So far I have this: last3::[a]-> Maybe a; last3 a | [] = Nothing | ([a]) = Just a | (_:xs) = last3 xs But I see this error messages : src/Main.hs at 10:8-10:10Not in scope: xs How to solve this ? Roelof From max.voit+mlhc at with-eyes.net Sun Nov 9 17:04:40 2014 From: max.voit+mlhc at with-eyes.net (Max Voit) Date: Sun, 9 Nov 2014 18:04:40 +0100 Subject: [Haskell-cafe] xs not in scope In-Reply-To: <545F9882.6080806@home.nl> References: <545F9882.6080806@home.nl> Message-ID: <20141109180440.25d3cba3@with-eyes.net> Hi Roelof, the problem is, you cannot pattern-match within guards. Guards take predicates. On your example: "last3 a" pattern-matches the first argument of last3 into a. You may now use a in all further statements. If, however, you want to do pattern matching, it would look like this: last3::[a]-> Maybe a; last3 [] = Nothing last3 ([a]) = Just a last3 (_:xs) = last3 xs Notice that the last case will never be executed, as the matching is complete with the first two case. Max Am Sun, 09 Nov 2014 17:38:26 +0100 schrieb Roelof Wobben : > Hello, > > Im trying to find several answers to problem1 of the 99 haskell > problems. Find the last item in a list. > > Now im trying to find a guarded solution. > So far I have this: > > last3::[a]-> Maybe a; > last3 a > | [] = Nothing > | ([a]) = Just a > | (_:xs) = last3 xs > > But I see this error messages : > > src/Main.hs at 10:8-10:10Not in scope: xs > > How to solve this ? > > Roelof > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From r.wobben at home.nl Sun Nov 9 17:10:52 2014 From: r.wobben at home.nl (Roelof Wobben) Date: Sun, 09 Nov 2014 18:10:52 +0100 Subject: [Haskell-cafe] xs not in scope In-Reply-To: <20141109180440.25d3cba3@with-eyes.net> References: <545F9882.6080806@home.nl> <20141109180440.25d3cba3@with-eyes.net> Message-ID: <545FA01C.1020108@home.nl> Oke, So this cannot be done with guards ? Roelof Max Voit schreef op 9-11-2014 18:04: > Hi Roelof, > > the problem is, you cannot pattern-match within guards. Guards take > predicates. > > On your example: "last3 a" pattern-matches the first argument of last3 > into a. You may now use a in all further statements. If, however, you > want to do pattern matching, it would look like this: > > last3::[a]-> Maybe a; > last3 [] = Nothing > last3 ([a]) = Just a > last3 (_:xs) = last3 xs > > Notice that the last case will never be executed, as the matching is > complete with the first two case. > > Max > > Am Sun, 09 Nov 2014 17:38:26 +0100 > schrieb Roelof Wobben : > >> Hello, >> >> Im trying to find several answers to problem1 of the 99 haskell >> problems. Find the last item in a list. >> >> Now im trying to find a guarded solution. >> So far I have this: >> >> last3::[a]-> Maybe a; >> last3 a >> | [] = Nothing >> | ([a]) = Just a >> | (_:xs) = last3 xs >> >> But I see this error messages : >> >> src/Main.hs at 10:8-10:10Not in scope: xs >> >> How to solve this ? >> >> Roelof >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From ky3 at atamo.com Sun Nov 9 17:11:41 2014 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Mon, 10 Nov 2014 00:11:41 +0700 Subject: [Haskell-cafe] xs not in scope In-Reply-To: <20141109180440.25d3cba3@with-eyes.net> References: <545F9882.6080806@home.nl> <20141109180440.25d3cba3@with-eyes.net> Message-ID: On Mon, Nov 10, 2014 at 12:04 AM, Max Voit wrote: > last3::[a]-> Maybe a; > last3 [] = Nothing > last3 ([a]) = Just a > last3 (_:xs) = last3 xs > > Notice that the last case will never be executed, as the matching is > complete with the first two case. Lists are tricky because of the special syntax. The first case is [] or Nil, the second is [a] which is equivalent to (a:[]). Hence there's a remaining case of a Cons cell (:) that's NOT followed by Nil ([]), which is the third case. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Sun Nov 9 18:33:09 2014 From: r.wobben at home.nl (Roelof Wobben) Date: Sun, 09 Nov 2014 19:33:09 +0100 Subject: [Haskell-cafe] Can I check the length in a guarded expresion Message-ID: <545FB365.1040000@home.nl> Hello, I try to make a guarded solution to find the last item in a list. I thought I could do something like this | length a == 1 = a But then I see a lot of error messages. Is there another way I can check the length of a list with guards ? Roelof From fa-ml at ariis.it Sun Nov 9 18:40:40 2014 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 9 Nov 2014 19:40:40 +0100 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FB365.1040000@home.nl> References: <545FB365.1040000@home.nl> Message-ID: <20141109184040.GA26183@x60s.casa> On Sun, Nov 09, 2014 at 07:33:09PM +0100, Roelof Wobben wrote: > Hello, > > I try to make a guarded solution to find the last item in a list. > > I thought I could do something like this > > | length a == 1 = a ^-- this is valid Haskell. > But then I see a lot of error messages. You should paste a complete example or the error or both, so people can easily see what went wrong with your code -F From bob at redivi.com Sun Nov 9 18:45:38 2014 From: bob at redivi.com (Bob Ippolito) Date: Sun, 9 Nov 2014 10:45:38 -0800 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FB365.1040000@home.nl> References: <545FB365.1040000@home.nl> Message-ID: You can do that. If you're getting an error, it's from a mistake on some other line. That said, you shouldn't write it that way. length requires a traversal of the entire list, so if the list is 1000 elements long it will take 1001 steps to compute that result when two steps would do. `length (take 2 a) == 1` would be a constant time way to get the result you want, although likely not the most elegant way to solve this exercise. Perhaps this is the sort of question better suited for the haskell-beginners mailing list: https://www.haskell.org/mailman/listinfo/beginners On Sun, Nov 9, 2014 at 10:33 AM, Roelof Wobben wrote: > Hello, > > I try to make a guarded solution to find the last item in a list. > > I thought I could do something like this > > | length a == 1 = a > > But then I see a lot of error messages. > > Is there another way I can check the length of a list with guards ? > > Roelof > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Sun Nov 9 18:51:32 2014 From: r.wobben at home.nl (Roelof Wobben) Date: Sun, 09 Nov 2014 19:51:32 +0100 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: References: <545FB365.1040000@home.nl> Message-ID: <545FB7B4.9080303@home.nl> An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sun Nov 9 18:55:58 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sun, 9 Nov 2014 10:55:58 -0800 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FB7B4.9080303@home.nl> References: <545FB365.1040000@home.nl> <545FB7B4.9080303@home.nl> Message-ID: The first guard returns a Maybe [a]. The second and third return an [a]. To make them all return the same type, you should be wrapping the second and third return values in a Just constructor. On Sun, Nov 9, 2014 at 10:51 AM, Roelof Wobben wrote: > Hello, > > Here is the complete solution : > > last3::[a]-> Maybe a; > last3 a > | null a = Nothing > | length a == 1 = a > otherwise last3 (tail a) > > And I see these error messages : > > src/Main.hs at 9:21-10:27 > Couldn't match expected type ?Bool -> ([a0] -> Maybe a0) -> [a] -> Maybe > a? with actual type > [a] > Relevant bindings include a :: [a] (bound at > /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:7) > last3 :: [a] -> Maybe a (bound at > /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:1) > The function > a > is applied to three arguments, but its type > [a] > has none ? > > > > > Bob Ippolito schreef op 9-11-2014 19:45: > > You can do that. If you're getting an error, it's from a mistake on some > other line. That said, you shouldn't write it that way. length requires a > traversal of the entire list, so if the list is 1000 elements long it will > take 1001 steps to compute that result when two steps would do. `length > (take 2 a) == 1` would be a constant time way to get the result you want, > although likely not the most elegant way to solve this exercise. > > Perhaps this is the sort of question better suited for the > haskell-beginners mailing list: > https://www.haskell.org/mailman/listinfo/beginners > > On Sun, Nov 9, 2014 at 10:33 AM, Roelof Wobben wrote: > >> Hello, >> >> I try to make a guarded solution to find the last item in a list. >> >> I thought I could do something like this >> >> | length a == 1 = a >> >> But then I see a lot of error messages. >> >> Is there another way I can check the length of a list with guards ? >> >> Roelof >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From britt.mathis at gmail.com Sun Nov 9 18:56:57 2014 From: britt.mathis at gmail.com (Britt Mathis) Date: Sun, 9 Nov 2014 13:56:57 -0500 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FB7B4.9080303@home.nl> References: <545FB365.1040000@home.nl> <545FB7B4.9080303@home.nl> Message-ID: I believe your problem is that the type of your function is [a] -> Maybe a, but you are returning a and last3 tail a, anything you return that is a Maybe needs to have either the Nothing or the Just constructor. On Nov 9, 2014 1:51 PM, "Roelof Wobben" wrote: > Hello, > > Here is the complete solution : > > last3::[a]-> Maybe a; > last3 a > | null a = Nothing > | length a == 1 = a > otherwise last3 (tail a) > > And I see these error messages : > > src/Main.hs at 9:21-10:27 > Couldn't match expected type ?Bool -> ([a0] -> Maybe a0) -> [a] -> Maybe > a? with actual type > [a] > Relevant bindings include a :: [a] (bound at > /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:7) > last3 :: [a] -> Maybe a (bound at > /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:1) > The function > a > is applied to three arguments, but its type > [a] > has none ? > > > > > Bob Ippolito schreef op 9-11-2014 19:45: > > You can do that. If you're getting an error, it's from a mistake on some > other line. That said, you shouldn't write it that way. length requires a > traversal of the entire list, so if the list is 1000 elements long it will > take 1001 steps to compute that result when two steps would do. `length > (take 2 a) == 1` would be a constant time way to get the result you want, > although likely not the most elegant way to solve this exercise. > > Perhaps this is the sort of question better suited for the > haskell-beginners mailing list: > https://www.haskell.org/mailman/listinfo/beginners > > On Sun, Nov 9, 2014 at 10:33 AM, Roelof Wobben wrote: > >> Hello, >> >> I try to make a guarded solution to find the last item in a list. >> >> I thought I could do something like this >> >> | length a == 1 = a >> >> But then I see a lot of error messages. >> >> Is there another way I can check the length of a list with guards ? >> >> Roelof >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andy at adradh.org.uk Sun Nov 9 18:59:39 2014 From: andy at adradh.org.uk (Andy Morris) Date: Sun, 9 Nov 2014 19:59:39 +0100 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FB7B4.9080303@home.nl> References: <545FB365.1040000@home.nl> <545FB7B4.9080303@home.nl> Message-ID: <2A7BCC48-F317-4B56-B428-33CBD63FBE01@me.com> You also forgot the `|` and `=` either side of the `otherwise`. So the weird error is because GHC is understanding the second clause to be the application `a otherwise last3 (tail a)`. > On 09 Nov 2014, at 19:51, Roelof Wobben wrote: > > Hello, > > Here is the complete solution : > > last3::[a]-> Maybe a; > last3 a > | null a = Nothing > | length a == 1 = a > otherwise last3 (tail a) > > And I see these error messages : > > src/Main.hs at 9:21-10:27 > Couldn't match expected type ?Bool -> ([a0] -> Maybe a0) -> [a] -> Maybe a? with actual type > [a] > Relevant bindings include a :: [a] (bound at /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:7) last3 :: [a] -> Maybe a (bound at /home/app/isolation-runner-work/projects/75679/session.207/src/src/Main.hs:7:1) The function > a > is applied to three arguments, but its type > [a] > has none ? > > > > > Bob Ippolito schreef op 9-11-2014 19:45: >> You can do that. If you're getting an error, it's from a mistake on some other line. That said, you shouldn't write it that way. length requires a traversal of the entire list, so if the list is 1000 elements long it will take 1001 steps to compute that result when two steps would do. `length (take 2 a) == 1` would be a constant time way to get the result you want, although likely not the most elegant way to solve this exercise. >> >> Perhaps this is the sort of question better suited for the haskell-beginners mailing list: https://www.haskell.org/mailman/listinfo/beginners >> >> On Sun, Nov 9, 2014 at 10:33 AM, Roelof Wobben > wrote: >> Hello, >> >> I try to make a guarded solution to find the last item in a list. >> >> I thought I could do something like this >> >> | length a == 1 = a >> >> But then I see a lot of error messages. >> >> Is there another way I can check the length of a list with guards ? >> >> Roelof >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Sun Nov 9 19:07:35 2014 From: r.wobben at home.nl (Roelof Wobben) Date: Sun, 09 Nov 2014 20:07:35 +0100 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <2A7BCC48-F317-4B56-B428-33CBD63FBE01@me.com> References: <545FB365.1040000@home.nl> <545FB7B4.9080303@home.nl> <2A7BCC48-F317-4B56-B428-33CBD63FBE01@me.com> Message-ID: <545FBB77.6040001@home.nl> An HTML attachment was scrubbed... URL: From roma at ro-che.info Sun Nov 9 22:16:01 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sun, 09 Nov 2014 17:16:01 -0500 Subject: [Haskell-cafe] xs not in scope In-Reply-To: <545FA01C.1020108@home.nl> References: <545F9882.6080806@home.nl> <20141109180440.25d3cba3@with-eyes.net> <545FA01C.1020108@home.nl> Message-ID: <545FE7A1.7000801@ro-che.info> You could use pattern guards. last3 :: [a] -> Maybe a; last3 a | [] <- a = Nothing ... On 09/11/14 12:10, Roelof Wobben wrote: > Oke, > > So this cannot be done with guards ? > > Roelof > > > Max Voit schreef op 9-11-2014 18:04: >> Hi Roelof, >> >> the problem is, you cannot pattern-match within guards. Guards take >> predicates. >> >> On your example: "last3 a" pattern-matches the first argument of last3 >> into a. You may now use a in all further statements. If, however, you >> want to do pattern matching, it would look like this: >> >> last3::[a]-> Maybe a; >> last3 [] = Nothing >> last3 ([a]) = Just a >> last3 (_:xs) = last3 xs >> >> Notice that the last case will never be executed, as the matching is >> complete with the first two case. >> >> Max >> >> Am Sun, 09 Nov 2014 17:38:26 +0100 >> schrieb Roelof Wobben : >> >>> Hello, >>> >>> Im trying to find several answers to problem1 of the 99 haskell >>> problems. Find the last item in a list. >>> >>> Now im trying to find a guarded solution. >>> So far I have this: >>> >>> last3::[a]-> Maybe a; >>> last3 a >>> | [] = Nothing >>> | ([a]) = Just a >>> | (_:xs) = last3 xs >>> >>> But I see this error messages : >>> >>> src/Main.hs at 10:8-10:10Not in scope: xs >>> >>> How to solve this ? >>> >>> Roelof >>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > . > From donn at avvanta.com Mon Nov 10 02:58:37 2014 From: donn at avvanta.com (Donn Cave) Date: Sun, 9 Nov 2014 18:58:37 -0800 (PST) Subject: [Haskell-cafe] list comprehension with multiple generator|targets Message-ID: <20141110025837.F08FB276CB7@mail.avvanta.com> I'm guessing this isn't supported, but might be worth asking - can I extend a list comprehension like ['A' | A <- s] to multiple values? Like, data V = A | B | C pv :: [V] -> [Char] pv [] = [] pv (A:x) = 'A':(pv x) pv (B:x) = 'B':(pv x) pv (_:x) = pv x -- can that be a list comprehension, like pv s = [ 'A' | A <- s -- ?? ] thanks, Donn From raphaelsimeon at gmail.com Mon Nov 10 03:10:59 2014 From: raphaelsimeon at gmail.com (=?UTF-8?Q?Rapha=C3=ABl_Mongeau?=) Date: Sun, 9 Nov 2014 22:10:59 -0500 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: <20141110025837.F08FB276CB7@mail.avvanta.com> References: <20141110025837.F08FB276CB7@mail.avvanta.com> Message-ID: I don't think list comprehension is the solution. What you want is a map. Would this work? data V = A | B | C f :: [V] -> String f l = flip map l $ \x -> case x of A -> 'A' B -> 'B' C -> 'C' main = print $ f [A,B,C,C,A] 2014-11-09 21:58 GMT-05:00 Donn Cave : > I'm guessing this isn't supported, but might be worth asking - > can I extend a list comprehension like ['A' | A <- s] to multiple values? > Like, > > data V = A | B | C > > pv :: [V] -> [Char] > pv [] = [] > pv (A:x) = 'A':(pv x) > pv (B:x) = 'B':(pv x) > pv (_:x) = pv x > > -- can that be a list comprehension, like > > pv s = [ > 'A' | A <- s > -- ?? > ] > > thanks, > Donn > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Viva Cila -------------- next part -------------- An HTML attachment was scrubbed... URL: From mail at nils.cc Mon Nov 10 03:18:00 2014 From: mail at nils.cc (Nils Schweinsberg) Date: Mon, 10 Nov 2014 04:18:00 +0100 Subject: [Haskell-cafe] IO and exceptions In-Reply-To: References: <545F680D.50708@ro-che.info> <545F6E3A.7010303@orlitzky.com> <545F71D5.9060906@ro-che.info> Message-ID: There's also the `ExceptT` monad transformer, which effectively binds exceptions to a type: http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html It is not restrictive in any way, though, ie. there still can be other excpetions raised in your application unless you account for them, but otherwise it does a decent job at managing exceptions? On Sun, Nov 9, 2014 at 4:01 PM, Michal Antkiewicz wrote: > Whether thrown exceptions should be explicitly part of interface or not is > still an open issue. For example, Java requires to explicitly declare the > exception as part of method signature. And people complained... Then in > Scala, for example, there's no such requirement. I've seen a paper showing > negative consequences of implicit exceptions but I cannot find it now (I > thought it was ICSE 2014...). > > I found some other paper contrasting implicit vs. explicit exception flows. > > > http://www.les.inf.puc-rio.br/opus/docs/pubs/2009/10_NelioCacho-SBES2009.pdf > > So, sometimes you need to handle the exception at the call site but if > it's required that people simply "swallow" the exception (catch and do > nothing), sometimes you need to handle them centrally in some way. I'm not > sure what is best for Haskell. > > Michal > > > On Sun, Nov 9, 2014 at 8:53 AM, Roman Cheplyaka wrote: > >> On 09/11/14 08:38, Michael Orlitzky wrote: >> > On 11/09/2014 08:11 AM, Roman Cheplyaka wrote: >> >> Let's say you knew what exceptions could be thrown. What would you do >> >> differently then? >> >> >> >> Typically, if it's a command-line app and something unexpected happens, >> >> you simply present the error to the user. That's what exceptions do >> >> already without any effort from you. >> >> >> > >> > The output from the exception is usually useless, though. Rather than, >> > >> > *** Exception: EACCES >> > >> > (or something similar, whatever, I'm making it up), I want to show: >> > >> > Insufficient permissions for accessing /run/. This can be fixed >> > by granting write and execute access on that directory to the user >> > under which the application is running. >> > >> > If the operation can fail in different ways -- like if the directory is >> > missing entirely -- I need to pattern match on the exception and display >> > something else. >> > >> > Another example: I don't want to log a "read error" in my daemon, which >> > is what I'll get if I log the exception. I want to know *what* failed to >> > be read. Was it a file (that a cron job deleted) or a network socket >> > (whose connection was dropped)? I need to catch those in the code, where >> > I know what's being read, and what the "read error" means in context. >> >> Both points are valid. >> >> Re the first, you still can achieve it by pattern-matching on >> exceptions. The fact that you don't know the exact set of exceptions >> makes it harder, but the truth is, for a non-trivial application, that >> set would be huge. Like, let's say you use a database. It brings in all >> sorts of network-related exceptions and database-level exceptions. >> >> The way to handle those, as you point out, is to augment them with >> high-level information ("Could not retrieve user's data"), and then >> maybe attach the low-level exception for debugging purposes. Again, you >> don't really need to know the whole set of exceptions in order to do >> that. Just wrap your database access function in 'try', and you'll know >> that whatever exception was caught, it prevented the retrieval of user's >> data (but keep in mind that it might be an asynchronous exception >> unrelated to your database activity). >> >> Roman >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fuuzetsu at fuuzetsu.co.uk Mon Nov 10 03:18:10 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 10 Nov 2014 03:18:10 +0000 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: References: <20141110025837.F08FB276CB7@mail.avvanta.com> Message-ID: <54602E72.6070501@fuuzetsu.co.uk> On 11/10/2014 03:10 AM, Rapha?l Mongeau wrote: > I don't think list comprehension is the solution. What you want is a map. > > Would this work? > > > data V = A | B | C > > f :: [V] -> String > f l = flip map l $ \x -> case x of > A -> 'A' > B -> 'B' > C -> 'C' Looks like the job for LambdaCase, ?flip map l $ \case ?? Also it doesn't do what the OPs function does because it doesn't skip C. > main = print $ f [A,B,C,C,A] > > 2014-11-09 21:58 GMT-05:00 Donn Cave : > >> I'm guessing this isn't supported, but might be worth asking - >> can I extend a list comprehension like ['A' | A <- s] to multiple values? >> Like, >> >> data V = A | B | C >> >> pv :: [V] -> [Char] >> pv [] = [] >> pv (A:x) = 'A':(pv x) >> pv (B:x) = 'B':(pv x) >> pv (_:x) = pv x >> >> -- can that be a list comprehension, like >> >> pv s = [ >> 'A' | A <- s >> -- ?? >> ] >> >> thanks, >> Donn -- Mateusz K. From fuuzetsu at fuuzetsu.co.uk Mon Nov 10 03:28:13 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 10 Nov 2014 03:28:13 +0000 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: <20141110025837.F08FB276CB7@mail.avvanta.com> References: <20141110025837.F08FB276CB7@mail.avvanta.com> Message-ID: <546030CD.7040509@fuuzetsu.co.uk> On 11/10/2014 02:58 AM, Donn Cave wrote: > I'm guessing this isn't supported, but might be worth asking - > can I extend a list comprehension like ['A' | A <- s] to multiple values? > Like, > > data V = A | B | C > > pv :: [V] -> [Char] > pv [] = [] > pv (A:x) = 'A':(pv x) > pv (B:x) = 'B':(pv x) > pv (_:x) = pv x > > -- can that be a list comprehension, like > > pv s = [ > 'A' | A <- s > -- ?? > ] > > thanks, > Donn You basically want map and filter. Moreover, you are also inlining a toChar function which complicates matters. If you have ?Eq V? instance and ?toChar? function then you could write it as [ toChar y | y <- [ x | x <- s, x /= C ] ] Where inner comprehension is just filter and outer is just map. It doesn't make much sense to do it this way and it imposes an extra constraint, Eq. Alternative (with LambdaCase): map toChar $ filter (\case { C -> False; _ -> True }) s But that's ugly and we still need toChar. Further, although not really applicable here, there might not be a reasonable toChar :: V -> Char for every constructor of V. So in conclusion, the way you have now is pretty good: it avoids Eq constraint and it doesn't force us to write (possibly partial) toChar. So to answer your question, no, you can't extend this very easily to multiple without effectively inlining your existing ?pv? function into the comprehension. -- Mateusz K. From raphaelsimeon at gmail.com Mon Nov 10 03:32:24 2014 From: raphaelsimeon at gmail.com (=?UTF-8?Q?Rapha=C3=ABl_Mongeau?=) Date: Sun, 9 Nov 2014 22:32:24 -0500 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: <546030CD.7040509@fuuzetsu.co.uk> References: <20141110025837.F08FB276CB7@mail.avvanta.com> <546030CD.7040509@fuuzetsu.co.uk> Message-ID: Wow, didn't know about the LambdaCase. Here is the code with LambdaCase, filter and Eq {-# LANGUAGE LambdaCase #-} data V = A | B | C deriving (Eq) f :: [V] -> String f l = flip map (filter (/= C) l) $ \case A -> 'A' B -> 'B' main = print $ f [A,B,C,C,A] 2014-11-09 22:28 GMT-05:00 Mateusz Kowalczyk : > On 11/10/2014 02:58 AM, Donn Cave wrote: > > I'm guessing this isn't supported, but might be worth asking - > > can I extend a list comprehension like ['A' | A <- s] to multiple > values? > > Like, > > > > data V = A | B | C > > > > pv :: [V] -> [Char] > > pv [] = [] > > pv (A:x) = 'A':(pv x) > > pv (B:x) = 'B':(pv x) > > pv (_:x) = pv x > > > > -- can that be a list comprehension, like > > > > pv s = [ > > 'A' | A <- s > > -- ?? > > ] > > > > thanks, > > Donn > > You basically want map and filter. Moreover, you are also inlining a > toChar function which complicates matters. > > If you have ?Eq V? instance and ?toChar? function then you could write it > as > > [ toChar y | y <- [ x | x <- s, x /= C ] ] > > Where inner comprehension is just filter and outer is just map. It > doesn't make much sense to do it this way and it imposes an extra > constraint, Eq. Alternative (with LambdaCase): > > map toChar $ filter (\case { C -> False; _ -> True }) s > > But that's ugly and we still need toChar. Further, although not really > applicable here, there might not be a reasonable toChar :: V -> Char for > every constructor of V. > > So in conclusion, the way you have now is pretty good: it avoids Eq > constraint and it doesn't force us to write (possibly partial) toChar. > > So to answer your question, no, you can't extend this very easily to > multiple without effectively inlining your existing ?pv? function into > the comprehension. > > -- > Mateusz K. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Viva Cila -------------- next part -------------- An HTML attachment was scrubbed... URL: From fuuzetsu at fuuzetsu.co.uk Mon Nov 10 03:33:38 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 10 Nov 2014 03:33:38 +0000 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: <546030CD.7040509@fuuzetsu.co.uk> References: <20141110025837.F08FB276CB7@mail.avvanta.com> <546030CD.7040509@fuuzetsu.co.uk> Message-ID: <54603212.7070704@fuuzetsu.co.uk> On 11/10/2014 03:28 AM, Mateusz Kowalczyk wrote: > On 11/10/2014 02:58 AM, Donn Cave wrote: >> I'm guessing this isn't supported, but might be worth asking - >> can I extend a list comprehension like ['A' | A <- s] to multiple values? >> Like, >> >> data V = A | B | C >> >> pv :: [V] -> [Char] >> pv [] = [] >> pv (A:x) = 'A':(pv x) >> pv (B:x) = 'B':(pv x) >> pv (_:x) = pv x >> >> -- can that be a list comprehension, like >> >> pv s = [ >> 'A' | A <- s >> -- ?? >> ] >> >> thanks, >> Donn > > You basically want map and filter. Moreover, you are also inlining a > toChar function which complicates matters. > > If you have ?Eq V? instance and ?toChar? function then you could write it as > > [ toChar y | y <- [ x | x <- s, x /= C ] ] > > Where inner comprehension is just filter and outer is just map. It > doesn't make much sense to do it this way and it imposes an extra > constraint, Eq. Alternative (with LambdaCase): > > map toChar $ filter (\case { C -> False; _ -> True }) s > > But that's ugly and we still need toChar. Further, although not really > applicable here, there might not be a reasonable toChar :: V -> Char for > every constructor of V. Oh, forgot to mention one thing. You could have a toChar :: V -> Maybe Char and have a comprehension like [ y | Just y <- [ toChar x | x <- s, x /= C ] ] a.k.a. mapMaybe toChar . filter (/= C) and without Eq mapMaybe toChar . filter (\case { C -> False; _ -> True }) but we still need to write toChar separately and the comprehension still has Eq constraint. Of course we could inline the pattern match and so on but in the end it's all just ugly. Stick to what you have. > So in conclusion, the way you have now is pretty good: it avoids Eq > constraint and it doesn't force us to write (possibly partial) toChar. > > So to answer your question, no, you can't extend this very easily to > multiple without effectively inlining your existing ?pv? function into > the comprehension. > -- Mateusz K. From fuuzetsu at fuuzetsu.co.uk Mon Nov 10 03:37:53 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 10 Nov 2014 03:37:53 +0000 Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: References: <20141110025837.F08FB276CB7@mail.avvanta.com> <546030CD.7040509@fuuzetsu.co.uk> Message-ID: <54603311.8080107@fuuzetsu.co.uk> On 11/10/2014 03:32 AM, Rapha?l Mongeau wrote: > Wow, didn't know about the LambdaCase. > > Here is the code with LambdaCase, filter and Eq > > {-# LANGUAGE LambdaCase #-} > > data V = A | B | C deriving (Eq) > > f :: [V] -> String > f l = flip map (filter (/= C) l) $ \case > A -> 'A' > B -> 'B' > > main = print $ f [A,B,C,C,A] The problem with this solution is that your pattern match is partial. Add a D constructor and you get a pattern match failure. You could extend to ?\case { A -> Just 'A'; ?; _ -> Nothing }? and use mapMaybe instead of map but it doesn't answer the question of using list comprehensions. > > 2014-11-09 22:28 GMT-05:00 Mateusz Kowalczyk : > >> On 11/10/2014 02:58 AM, Donn Cave wrote: >>> I'm guessing this isn't supported, but might be worth asking - >>> can I extend a list comprehension like ['A' | A <- s] to multiple >> values? >>> Like, >>> >>> data V = A | B | C >>> >>> pv :: [V] -> [Char] >>> pv [] = [] >>> pv (A:x) = 'A':(pv x) >>> pv (B:x) = 'B':(pv x) >>> pv (_:x) = pv x >>> >>> -- can that be a list comprehension, like >>> >>> pv s = [ >>> 'A' | A <- s >>> -- ?? >>> ] >>> >>> thanks, >>> Donn >> >> You basically want map and filter. Moreover, you are also inlining a >> toChar function which complicates matters. >> >> If you have ?Eq V? instance and ?toChar? function then you could write it >> as >> >> [ toChar y | y <- [ x | x <- s, x /= C ] ] >> >> Where inner comprehension is just filter and outer is just map. It >> doesn't make much sense to do it this way and it imposes an extra >> constraint, Eq. Alternative (with LambdaCase): >> >> map toChar $ filter (\case { C -> False; _ -> True }) s >> >> But that's ugly and we still need toChar. Further, although not really >> applicable here, there might not be a reasonable toChar :: V -> Char for >> every constructor of V. >> >> So in conclusion, the way you have now is pretty good: it avoids Eq >> constraint and it doesn't force us to write (possibly partial) toChar. >> >> So to answer your question, no, you can't extend this very easily to >> multiple without effectively inlining your existing ?pv? function into >> the comprehension. >> >> -- >> Mateusz K. >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > -- Mateusz K. From ok at cs.otago.ac.nz Mon Nov 10 03:40:12 2014 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Mon, 10 Nov 2014 16:40:12 +1300 Subject: [Haskell-cafe] Can I check the length in a guarded expresion In-Reply-To: <545FBB77.6040001@home.nl> References: <545FB365.1040000@home.nl> <545FB7B4.9080303@home.nl> <2A7BCC48-F317-4B56-B428-33CBD63FBE01@me.com> <545FBB77.6040001@home.nl> Message-ID: <852187A9-53AB-47B5-941C-DFDF1CBFB2FB@cs.otago.ac.nz> On 10/11/2014, at 8:07 am, Roelof Wobben wrote: > Found it. > > This is working ; > > last3::[a]-> Maybe a; > last3 a > | null a = Nothing > | length a == 1 = Just (head a) > | otherwise = last3 (tail a) I believe it has already been mentioned, but what you have here is an O(|a|**2) solution. The way I?d write it is last4 :: [a] -> Maybe a last4 [] = Nothing last4 (x:xs) = Just $ loop x xs where loop x [] = x loop _ (y:ys) = loop y ys In ghci, *Main> :set +s *Main> last3 [1..10000] Just 10000 (0.14 secs, 13696656 bytes) *Main> last4 [1..10000] Just 10000 (0.00 secs, 3131552 bytes) *Main> last3 [1..100000] Just 100000 (11.92 secs, 33134136 bytes) *Main> last4 [1..100000] Just 100000 (0.02 secs, 15520360 bytes) You really _don?t_ want to be calling length in a loop like that. length a == 1 if and only if a == [_] Using null, head, tail is not really the Haskell Way. last3 [] = Nothing last3 [x] = Just x last3 (_:xs) = last3 xs From donn at avvanta.com Mon Nov 10 03:47:56 2014 From: donn at avvanta.com (Donn Cave) Date: Sun, 9 Nov 2014 19:47:56 -0800 (PST) Subject: [Haskell-cafe] list comprehension with multiplegenerator|targets In-Reply-To: <54603311.8080107@fuuzetsu.co.uk> References: <54603311.8080107@fuuzetsu.co.uk> Message-ID: <20141110034756.32F8E276D6C@mail.avvanta.com> quoth Mateusz Kowalczyk [... re someone else's example ] >> {-# LANGUAGE LambdaCase #-} >> >> data V = A | B | C deriving (Eq) >> >> f :: [V] -> String >> f l = flip map (filter (/= C) l) $ \case >> A -> 'A' >> B -> 'B' >> >> main = print $ f [A,B,C,C,A] > > The problem with this solution is that your pattern match is partial. > Add a D constructor and you get a pattern match failure. You could > extend to ?\case { A -> Just 'A'; ?; _ -> Nothing }? and use mapMaybe > instead of map but it doesn't answer the question of using list > comprehensions. Indeed, I'd rigged up something with Maybe for this, like pv a = [t | Just t <- pvc a] where pvc A = Just 'A' pvc B = Just 'B' _ = Nothing ... when it occurred to me that I might be wasting the power of the list comprehensions that I so rarely use. Guess not! Thanks, Donn From raphaelsimeon at gmail.com Mon Nov 10 04:07:59 2014 From: raphaelsimeon at gmail.com (=?UTF-8?Q?Rapha=C3=ABl_Mongeau?=) Date: Sun, 9 Nov 2014 23:07:59 -0500 Subject: [Haskell-cafe] list comprehension with multiplegenerator|targets In-Reply-To: <20141110034756.32F8E276D6C@mail.avvanta.com> References: <54603311.8080107@fuuzetsu.co.uk> <20141110034756.32F8E276D6C@mail.avvanta.com> Message-ID: This : pv a = [t | Just t <- pvc a] is strange, can we really do pattern matching inside list comprehension? If I try to make your code work its lead me to this: import Data.Maybe data V = A | B | C pv l = catMaybes [pvc e | e <- l] where pvc A = Just 'A' pvc B = Just 'B' pvc _ = Nothing main = print $ pv [A,B,C,C,A] As you can see, [pvc e | e <- l] is just "map (plv) l" and I think the where is more clear with a lambdaCase. {-# LANGUAGE LambdaCase #-} import Data.Maybe data V = A | B | C pv l = catMaybes $ flip map l $ \case A -> Just 'A' B -> Just 'B' _ -> Nothing main = print $ pv [A,B,C,C,A] No, this solution does not use list comprehension, but your problem need some form of pattern matching and as Mateusz said, inlining it inside the function would be ugly. Since all the real work of your problem is in the case with the Maybe and the _ I think list comprehension can't offer much. I think its interesting how the case is doing the job of the earlier discussed filter AND the mapping to a char. And as a bonus it support adding D, E, F ... to the V data without much trouble. 2014-11-09 22:47 GMT-05:00 Donn Cave : > quoth Mateusz Kowalczyk > [... re someone else's example ] > >> {-# LANGUAGE LambdaCase #-} > >> > >> data V = A | B | C deriving (Eq) > >> > >> f :: [V] -> String > >> f l = flip map (filter (/= C) l) $ \case > >> A -> 'A' > >> B -> 'B' > >> > >> main = print $ f [A,B,C,C,A] > > > > The problem with this solution is that your pattern match is partial. > > Add a D constructor and you get a pattern match failure. You could > > extend to ?\case { A -> Just 'A'; ?; _ -> Nothing }? and use mapMaybe > > instead of map but it doesn't answer the question of using list > > comprehensions. > > Indeed, I'd rigged up something with Maybe for this, like > > pv a = [t | Just t <- pvc a] > where > pvc A = Just 'A' > pvc B = Just 'B' > _ = Nothing > > ... when it occurred to me that I might be wasting the power of the > list comprehensions that I so rarely use. Guess not! Thanks, > > Donn > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Viva Cila -------------- next part -------------- An HTML attachment was scrubbed... URL: From mle+hs at mega-nerd.com Mon Nov 10 04:16:34 2014 From: mle+hs at mega-nerd.com (Erik de Castro Lopo) Date: Sun, 9 Nov 2014 20:16:34 -0800 Subject: [Haskell-cafe] Test Framework, HUnit In-Reply-To: <201410222205.13853.jan.stolarek@p.lodz.pl> References: <201410222205.13853.jan.stolarek@p.lodz.pl> Message-ID: <20141109201634.33647e0c1cb1e56f9758afbb@mega-nerd.com> Jan Stolarek wrote: > I believe test-framework has been abandoned. Use tasty instead. Also look at Hspec which is actively maintained and well documented. Erik -- ---------------------------------------------------------------------- Erik de Castro Lopo http://www.mega-nerd.com/ From allbery.b at gmail.com Mon Nov 10 04:19:02 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Sun, 9 Nov 2014 23:19:02 -0500 Subject: [Haskell-cafe] list comprehension with multiplegenerator|targets In-Reply-To: References: <54603311.8080107@fuuzetsu.co.uk> <20141110034756.32F8E276D6C@mail.avvanta.com> Message-ID: On Sun, Nov 9, 2014 at 11:07 PM, Rapha?l Mongeau wrote: > This : > pv a = [t | Just t <- pvc a] > is strange, can we really do pattern matching inside list comprehension? > Yes; that's part of the point of list comprehensions, and of their extension to (and, back in the very early days, contraction from) monad comprehensions. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From donn at avvanta.com Mon Nov 10 04:24:40 2014 From: donn at avvanta.com (Donn Cave) Date: Sun, 9 Nov 2014 20:24:40 -0800 (PST) Subject: [Haskell-cafe] list comprehension with multiplegenerator|targets In-Reply-To: References: Message-ID: <20141110042440.BD4DD93C40@mail.avvanta.com> quoth Rapha?l_Mongeau > This : > pv a = [t | Just t <- pvc a] > is strange, can we really do pattern matching inside list comprehension? Sure, but from a list - I'm sorry, I meant "map pvc a", not "pvc a". pv a = [t | Just t <- map pvc a] where pvc A = Just 'A' pvc B = Just 'B' pvc _ = Nothing You know, the pattern match in the list comprehension is just what I wanted it for in the first place - remember ['A' | A <- s] ? That's OK, it just isn't useful because I can do this for only one target. > ... and I think is more clear with a lambdaCase. lambdaCase is a great thing, but given that it's hardly any different > pv l = catMaybes $ flip map l $ \case > A -> Just 'A' > B -> Just 'B' > _ -> Nothing from pv l = catMaybes $ map pvc l where pvc A = Just 'A' pvc B = Just 'B' pvc _ = Nothing ... in this case I don't think we're desperate enough to use a nonstandard extension. Donn From fuuzetsu at fuuzetsu.co.uk Mon Nov 10 06:50:09 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 10 Nov 2014 06:50:09 +0000 Subject: [Haskell-cafe] list comprehension with multiplegenerator|targets In-Reply-To: <20141110042440.BD4DD93C40@mail.avvanta.com> References: <20141110042440.BD4DD93C40@mail.avvanta.com> Message-ID: <54606021.8020400@fuuzetsu.co.uk> On 11/10/2014 04:24 AM, Donn Cave wrote: > quoth Rapha?l_Mongeau > >> This : >> pv a = [t | Just t <- pvc a] >> is strange, can we really do pattern matching inside list comprehension? > > Sure, but from a list - I'm sorry, I meant "map pvc a", not "pvc a". > > pv a = [t | Just t <- map pvc a] > where > pvc A = Just 'A' > pvc B = Just 'B' > pvc _ = Nothing > > You know, the pattern match in the list comprehension is just what > I wanted it for in the first place - remember ['A' | A <- s] ? > That's OK, it just isn't useful because I can do this for only > one target. > >> ... and I think is more clear with a lambdaCase. > > lambdaCase is a great thing, but given that it's hardly any different > >> pv l = catMaybes $ flip map l $ \case >> A -> Just 'A' >> B -> Just 'B' >> _ -> Nothing > > from > > pv l = catMaybes $ map pvc l > where > pvc A = Just 'A' > pvc B = Just 'B' > pvc _ = Nothing catMaybes . map f = mapMaybe f Also I wonder if laziness saves us here: in the original program we effectively do map and filter at the same time. If we were to take (catMaybes . map f) with strict evaluation then we'd be traversing twice: once to map and once to catMaybes? Just something to think about, I think performance would be no worse anyway, at least not by much. > ... in this case I don't think we're desperate enough to use a > nonstandard extension. I wouldn't worry about using a ?non-standard? extension: you're probably not going to stick to H98 or H2010 in non-trivial programs either way. LambaCase is just a trivially expandable sugar anyway, modulo clean identifier name. -- Mateusz K. From donn at avvanta.com Mon Nov 10 08:04:45 2014 From: donn at avvanta.com (Donn Cave) Date: Mon, 10 Nov 2014 00:04:45 -0800 (PST) Subject: [Haskell-cafe] list comprehension with multiple generator|targets In-Reply-To: <54606021.8020400@fuuzetsu.co.uk> References: <54606021.8020400@fuuzetsu.co.uk> Message-ID: <20141110080445.96CDC276CB7@mail.avvanta.com> quoth Mateusz Kowalczyk ... > Also I wonder if laziness saves us here: in the original program we > effectively do map and filter at the same time. If we were to take > (catMaybes . map f) with strict evaluation then we'd be traversing > twice: once to map and once to catMaybes? Just something to think about, > I think performance would be no worse anyway, at least not by much. Might be right, I really have little idea what's going on underneath there - I'd have guessed that lazy or not, the two functions are doing all the work of traversing their separate lists even if at any conceptual moment those lists are nothing but a head and a tail. The rationale is mostly about a cleaner presentation. I was thinking of this problem a few weeks back when we were talking about C programmers learning Haskell. I'd guess they'd find a certain lack of elegance in the Maybe strategy, compared to what would be a pretty simple and direct problem in C, like "for (i = j = 0; i < n; ++i) if (toChar(vx[i], &cx[j]) ++j;" The recursive function I wrote for reference is my least favorite solution, less clear and more prone to stupid coding errors. If my list comprehension idea had been valid, I think it would have been a very concise presentation. >> ... in this case I don't think we're desperate enough to use a >> nonstandard extension. > > I wouldn't worry about using a ?non-standard? extension: you're probably > not going to stick to H98 or H2010 in non-trivial programs either way. > LambaCase is just a trivially expandable sugar anyway, modulo clean > identifier name. I do make frequent use of ForeignFunctionInterface, but perhaps that's the exception that proves the rule inasmuch as it has little to do with the language per se. I'm happy that I don't have to deal with programs that couldn't have been written without extensions. Donn From sean at functionaljobs.com Mon Nov 10 17:00:01 2014 From: sean at functionaljobs.com (Functional Jobs) Date: Mon, 10 Nov 2014 12:00:01 -0500 Subject: [Haskell-cafe] New Functional Programming Job Opportunities Message-ID: <5460ef16c7207@functionaljobs.com> Here are some functional programming job opportunities that were posted recently: Senior Software Engineer at McGraw-Hill Education http://functionaljobs.com/jobs/8760-senior-software-engineer-at-mcgraw-hill-education Cheers, Sean Murphy FunctionalJobs.com From pablo at 0x221e.net Mon Nov 10 18:34:06 2014 From: pablo at 0x221e.net (Pablo Couto) Date: Mon, 10 Nov 2014 19:34:06 +0100 Subject: [Haskell-cafe] =?windows-1252?q?Hackage=92s_account_creation_down?= =?windows-1252?q?=3F?= In-Reply-To: <546104EA.9060607@infty.in> References: <546104EA.9060607@infty.in> Message-ID: <5461051E.8020300@0x221e.net> Is Hackage?s account creation (at http://hackage.haskell.org/users/register-request) down? I tried it a few times since last night, without luck. This is the message I get: Server error: fd:57: hClose: resource vanished (Broken pipe) Best regards, Pablo -------------- next part -------------- An HTML attachment was scrubbed... URL: From creichert07 at gmail.com Mon Nov 10 19:01:48 2014 From: creichert07 at gmail.com (Christopher Reichert) Date: Mon, 10 Nov 2014 13:01:48 -0600 Subject: [Haskell-cafe] =?utf-8?q?Hackage=E2=80=99s_account_creation_down?= =?utf-8?q?=3F?= In-Reply-To: <5461051E.8020300@0x221e.net> (Pablo Couto's message of "Mon, 10 Nov 2014 19:34:06 +0100") References: <546104EA.9060607@infty.in> <5461051E.8020300@0x221e.net> Message-ID: <54610b97.261cb60a.1cb7.7684@mx.google.com> The same seems to happen with reset password. I posted an issue regarding this: https://github.com/haskell/hackage-server/issues/274 Regards, -Christopher From pablo at 0x221e.net Mon Nov 10 19:18:32 2014 From: pablo at 0x221e.net (Pablo Couto) Date: Mon, 10 Nov 2014 20:18:32 +0100 Subject: [Haskell-cafe] =?windows-1252?q?Hackage=92s_account_creation_down?= =?windows-1252?q?=3F?= In-Reply-To: <54610b97.261cb60a.1cb7.7684@mx.google.com> References: <546104EA.9060607@infty.in> <5461051E.8020300@0x221e.net> <54610b97.261cb60a.1cb7.7684@mx.google.com> Message-ID: <54610F88.8050603@0x221e.net> Christopher Reichert wrote, on 2014-11-10 20:01: > The same seems to happen with reset password. > > I posted an issue regarding this: > https://github.com/haskell/hackage-server/issues/274 > > Regards, > -Christopher Thank you. I wasn?t aware of that issue. Best regards, Pablo From qdunkan at gmail.com Mon Nov 10 19:22:42 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Mon, 10 Nov 2014 11:22:42 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: On Sat, Nov 8, 2014 at 7:54 AM, Alex Petrov wrote: > If you have any feedback / comments / questions, know how to improve it or > would like to see more things covered, just ping me. Just from personal experience, the fact that haskell types like Bool and Char are Storable combined with hsc's low level nature makes it easy to create memory corruption bugs by writing `(#poke Struct field) flag` instead of `(#poke Struct field) (toBool flag)`. The former will compile and likely work most of the time, but will corrupt memory, which will eventually result in a nondeterministic GC crash some time after the actual corruption. In my case, it took over a year to find the bug. I wound up writing a CStorable class that omits the dangerous instances, but a better solution is probably to use a higher level tool that doesn't make you manually specify the types of struct fields. I won't make the mistake again, and I wouldn't want to encourage anyone else to make it either. If I were writing a tutorial the very least I'd put in red flashing warnings. From donn at avvanta.com Mon Nov 10 19:46:05 2014 From: donn at avvanta.com (Donn Cave) Date: Mon, 10 Nov 2014 11:46:05 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141110194605.2C1CCF3952@mail.avvanta.com> quoth Evan Laforge > > Just from personal experience, the fact that haskell types like Bool > and Char are Storable combined with hsc's low level nature makes it > easy to create memory corruption bugs by writing `(#poke Struct field) > flag` instead of `(#poke Struct field) (toBool flag)`. The former > will compile and likely work most of the time, but will corrupt > memory, which will eventually result in a nondeterministic GC crash > some time after the actual corruption. In my case, it took over a > year to find the bug. Could you explain this problem a little further? I looked in my code and found lots of stuff like `(#poke termios, c_iflag) a iflag', so was alarmed for a moment, but naturally I've declared iflag Word32, via the hsc #type macro. And I'd expect the targets of poking to be like that - full of CChar and Word32 etc. - foreign types of the appropriate size. The idea that there'd be anything else in there changes the perspective somewhat, and if that's common, indeed the tutorial should account for it. (Or maybe I completely misunderstand what's going on here!) Donn From kannan at cakoose.com Tue Nov 11 01:44:05 2014 From: kannan at cakoose.com (Kannan Goundan) Date: Tue, 11 Nov 2014 01:44:05 +0000 (UTC) Subject: [Haskell-cafe] Representing record subtypes, sort of. Message-ID: I have an API that, in a language with subtyping, would look like: class FsEntry id: String class FsFile extends FsEntry modified: Date size: Int class FsFolder extends FsEntry owner: String listFolder :: Path -> [FsEntry] createFile :: Path -> FsFile createFolder :: Path -> FsFolder (I'm assuming some way of specifying that FsEntry will only ever have those two subtypes.) How would you represent this in Haskell? My first thought was: newtype FsEntry = FsEntry FsCommon FsExtra data FsCommon = FsCommon { id: String } data FsExtra = FsFile { modified: Date, size: Int } | FsFolder { owner: String } But then I couldn't have precise return types for `writeFile` and `createFolder`. My next attempt was to use a type-parameterized top-level class: data FsCommon = FsCommon { id: String } data FsFileExtra = FsFileExtra { modified: Data, size: Int } data FsFolderExtra = FsFolderExtra { owner: String } data FsEither = FsFile FsFileExta | FsFolder FsFolderExtra newtype FsEntryBase extra = FsEntryBase FsCommon extra type FsEntry = FsEntryBase FsEither type FsFile = FsEntryBase FsFileExtra type FsFolder = FsEntryBase FsFolderExtra 1. This seems complicated. 2. I can't pass an `FsFolder` to a function expecting an `FsEntry`, but maybe that's just the nature of having subtyping and I have to give up on that (which I'm ok with). Any suggestions on how to do this? Thanks! From jeffbrown.the at gmail.com Tue Nov 11 03:09:57 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Mon, 10 Nov 2014 19:09:57 -0800 Subject: [Haskell-cafe] IO monads, stream handles, and type inference Message-ID: In the thread "Precise timing ", in response to something ugly I was doing, Rohan Drape provided the following code: import Control.Concurrent import Control.Monad import System.IO import Sound.OSC main = withMax $ mapM_ note (cycle [1,1,2]) withMax = withTransport (openUDP "127.0.0.1" 9000) sin0 param val = sendMessage (Message "sin0" [string param,float val]) pause = liftIO . pauseThread . (* 0.1) note n = do sin0 "frq" 300 sin0 "amp" 1 pause n sin0 "amp" 0 pause n For days I have monkeyed with it, and studied the libraries it imports, and I remain sorely confused. *How can the "a" in "IO a" be a handle?* Here are two type signatures: openUDP :: String -> Int -> IO UDP withTransport :: Transport t => IO t -> Connection t a -> IO a Rohan's code makes clear that openUDP creates a handle representing the UDP connection. openUDP's type signature indicates that its output is an "IO UDP". How can I reconcile those two facts? When I read about the IO type, all sources seem to indicate that "IO a" represents a value of type "a" wrapped in an IO context. For instance, when putting Strings to the screen, one passes around "IO String" values. Until this OSC library, I had never seen the "a" in "IO a" represent a pipe; it had always represented data to be passed *through* a pipe. *Why the long signature?* When I ask for it, GHC provides the following additional type signatures: > :t pause pause :: Double -> transformers-0.3.0.0:Control.Monad.Trans.Reader.ReaderT UDP IO () What's up with that? *What type is note? (and related questions)* GHCI goes on: > :t sin0 sin0 :: (SendOSC m, Real n) => String -> n -> m () > :t note note :: Double -> transformers-0.3.0.0:Control.Monad.Trans.Reader.ReaderT UDP IO () note calls both sin0 and pause. It appears that note's type signature takes pause, but not sin0, into account, but I must be wrong about that. sin0 returns a SendOSC. pause applies liftIO to pauseThread. The result must be a SendOSC too, because sin0 and pause are both called in the same do loop. SendOSC implements these three classes: (Monad (ReaderT t io), Transport t, MonadIO io) => SendOSC (ReaderT t io) Is the liftIO that pause applies to pauseThread, then, the "default" liftIO defined in the MonadIO library? *How to read the "instances" portion of Hackage documentation?* In the Hackage documentation for the SendOSC type, how should I be reading this line? (Monad (ReaderT t io), Transport t, MonadIO io) => SendOSC (ReaderT t io) I understand the middle two clauses: that io should be of type MonadIO, and t should be of type Transport. The outer two clauses, though, I don't know how to interpret. (I looked at the code and saw nothing that clearly corresponded to that line in the documentation.) -------------- next part -------------- An HTML attachment was scrubbed... URL: From karl at karlv.net Tue Nov 11 03:32:19 2014 From: karl at karlv.net (Karl Voelker) Date: Mon, 10 Nov 2014 19:32:19 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: Message-ID: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> On Mon, Nov 10, 2014, at 05:44 PM, Kannan Goundan wrote: > How would you represent this in Haskell? If you don't mind turning on a few language extensions: {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} module FS where type Date = String data FileKind = FILE | FOLDER data Entry (k :: FileKind) where File :: String -> Date -> Int -> Entry FILE Folder :: String -> String -> Entry FOLDER https://gist.github.com/ktvoelker/296f40966e2f1d4846e2 -Karl From allbery.b at gmail.com Tue Nov 11 03:41:56 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 10 Nov 2014 22:41:56 -0500 Subject: [Haskell-cafe] IO monads, stream handles, and type inference In-Reply-To: References: Message-ID: On Mon, Nov 10, 2014 at 10:09 PM, Jeffrey Brown wrote: > Until this OSC library, I had never seen the "a" in "IO a" represent a > pipe; it had always represented data to be passed *through* a pipe. > http://lambda.haskell.org/platform/doc/current/ghc-doc/libraries/haskell2010-1.1.1.0/System-IO.html#v:openFile produces an IO Handle. File I/O is often done with lazy I/O, which hides the Handle in the woodwork, but nothing stops you from using Handle-based I/O. > *Why the long signature?* > When I ask for it, GHC provides the following additional type signatures: > > :t pause pause :: Double -> > transformers-0.3.0.0:Control.Monad.Trans.Reader.ReaderT UDP IO () > What's up with that? > You don't have the module that defines the type ReaderT in scope, so it dug out where the module you *do* have in scope got it from. And it gave full details, because conceivably you could have multiple versions of the transformers library installed --- although that usually leads to a lot of confusion (which ghc is trying to avoid here by giving the full pedigree). BTW, I am going to guess, given that you later show a SendOSC that is a ReaderT UDP IO a, that SendOSC is a `type` (type alias) and not a `data` (a fully-fledged data type) or `newtype` (a wrapper for another type). That may answer your later questions: ghc will sometimes show the alias name and sometimes the type it expands to. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From rohan.drape at gmail.com Tue Nov 11 04:23:50 2014 From: rohan.drape at gmail.com (Rohan Drape) Date: Tue, 11 Nov 2014 04:23:50 +0000 (UTC) Subject: [Haskell-cafe] IO monads, stream handles, and type inference References: Message-ID: > *How to read the "instances" portion of Hackage documentation?* is there some reason to use hosc-0.13? the hackage documentation for 0.13 is very obscure on this point & for complicated reasons not much to do with hosc > I understand the middle two clauses: that io should be of type MonadIO, and > t should be of type Transport. hosc-0.15 says only "(Transport t, MonadIO io) => SendOSC (ReaderT t io)" so you may understand all there is to understand? best, rd From qdunkan at gmail.com Tue Nov 11 05:46:26 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Mon, 10 Nov 2014 21:46:26 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: Message-ID: I would probably write data Common = Common { ... } data File = File { fileCommon :: Common, ... } data Folder = Folder { folderCommon :: Common, ... } data Entry = EntryFile File | EntryFolder Folder entry f g (EntryFile a) = f a entry f g (EntryFolder b) = g b common = entry fileCommon folderCommon This is essentially your second approach, but with less scaffolding. You can pass a Folder to a function wanting an Entry just by composing EntryFile on the front. The GADT approach would work too, I suppose, maybe even nicer than mine. On Mon, Nov 10, 2014 at 5:44 PM, Kannan Goundan wrote: > I have an API that, in a language with subtyping, would look like: > > class FsEntry > id: String > > class FsFile extends FsEntry > modified: Date > size: Int > > class FsFolder extends FsEntry > owner: String > > listFolder :: Path -> [FsEntry] > createFile :: Path -> FsFile > createFolder :: Path -> FsFolder > > (I'm assuming some way of specifying that FsEntry will only ever have those > two subtypes.) > > How would you represent this in Haskell? My first thought was: > > newtype FsEntry = FsEntry FsCommon FsExtra > data FsCommon = FsCommon { id: String } > data FsExtra = FsFile { modified: Date, size: Int } > | FsFolder { owner: String } > > But then I couldn't have precise return types for `writeFile` and > `createFolder`. My next attempt was to use a type-parameterized top-level > class: > > data FsCommon = FsCommon { id: String } > data FsFileExtra = FsFileExtra { modified: Data, size: Int } > data FsFolderExtra = FsFolderExtra { owner: String } > data FsEither = FsFile FsFileExta | FsFolder FsFolderExtra > > newtype FsEntryBase extra = FsEntryBase FsCommon extra > type FsEntry = FsEntryBase FsEither > type FsFile = FsEntryBase FsFileExtra > type FsFolder = FsEntryBase FsFolderExtra > > 1. This seems complicated. > 2. I can't pass an `FsFolder` to a function expecting an `FsEntry`, but > maybe that's just the nature of having subtyping and I have to give up on > that (which I'm ok with). > > Any suggestions on how to do this? Thanks! > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From qdunkan at gmail.com Tue Nov 11 05:55:57 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Mon, 10 Nov 2014 21:55:57 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141110194605.2C1CCF3952@mail.avvanta.com> References: <20141110194605.2C1CCF3952@mail.avvanta.com> Message-ID: On Mon, Nov 10, 2014 at 11:46 AM, Donn Cave wrote: > Could you explain this problem a little further? I looked in my code > and found lots of stuff like `(#poke termios, c_iflag) a iflag', so was > alarmed for a moment, but naturally I've declared iflag Word32, via the > hsc #type macro. And I'd expect the targets of poking to be like that - > full of CChar and Word32 etc. - foreign types of the appropriate size. > The idea that there'd be anything else in there changes the perspective > somewhat, and if that's common, indeed the tutorial should account for it. > > (Or maybe I completely misunderstand what's going on here!) If you've ensured that iflag is a C type, then you've avoided the problem. But if, for instance, iflag was a Char, not a CChar, and you poke it into a 'char' struct field forgetting to convert to a CChar, you'll get memory corruption. I don't know if it's a common mistake, but I sure made it (very infrequently, but once is enough, in fact once is even worse), and the compiler won't tell you if you did. When I mentioned it on the list way back when no one responded, so maybe other people don't fall into that trap. From donn at avvanta.com Tue Nov 11 07:38:57 2014 From: donn at avvanta.com (Donn Cave) Date: Mon, 10 Nov 2014 23:38:57 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141111073857.1AFCA276C41@mail.avvanta.com> quoth Evan Laforge ... > If you've ensured that iflag is a C type, then you've avoided the > problem. But if, for instance, iflag was a Char, not a CChar, and you > poke it into a 'char' struct field forgetting to convert to a CChar, > you'll get memory corruption. I don't know if it's a common mistake, > but I sure made it (very infrequently, but once is enough, in fact > once is even worse), and the compiler won't tell you if you did. When > I mentioned it on the list way back when no one responded, so maybe > other people don't fall into that trap. Maybe they don't! I guess it isn't so much about exactly what you were up to, but for the sake of getting to whether there's an issue here for the tutorial, I wrote up a little example program, with CChar and Char. The commented alternatives work as well, at least it looks fine to me. Notes on this: - the C struct is { char a; char b; char c; } - the Haskell T struct uses CChar, and I assert that this is the only sane option -- no storable struct for foreign use should ever have a field type like Char. - that means the Storable instance in question is CChar, and it looks to me like poke reliably writes exactly one byte in this case, whatever value is supplied (I also tried Int.) - one might very well manage to keep all the poking to t fields in the T Storable instance - that's what I'd expect the tutorial to focus on. Not that it makes any great difference, but I'm just saying that the "ypoke" function in the example is there purely for the purpose of testing that Char/CChar thing you're talking about, and would be somewhat outside what I see as core usage. Donn ------------ {-# LANGUAGE ForeignFunctionInterface #-} module Main (main) where import Foreign import Foreign.C #include "ffipokehsc.h" data T = T { taflag :: CChar , tbflag :: CChar , tcflag :: CChar } deriving Show instance Storable T where sizeOf _ = #size struct t alignment _ = alignment (undefined::CDouble) peek p = do aflag <- (#peek struct t, a) p bflag <- (#peek struct t, b) p cflag <- (#peek struct t, c) p return (T aflag bflag cflag) poke p (T aflag bflag cflag) = do (#poke struct t, a) p aflag (#poke struct t, b) p bflag (#poke struct t, c) p cflag -- ypoke :: CChar -> CChar -> CChar -> IO T ypoke :: Char -> Char -> Char -> IO T ypoke a b c = alloca $ \ tp -> do (#poke struct t, a) tp a (#poke struct t, b) tp b (#poke struct t, c) tp c peek tp -- main = ypoke 97 98 99 >>= print -- main = ypoke 'a' 'b' 'c' >>= print tptr :: T -> IO (Ptr T) tptr t = alloca $ \ pt -> do poke pt t return pt main = do p <- tptr (T 97 98 99) t <- peek p print t From semen at trygub.com Tue Nov 11 12:01:35 2014 From: semen at trygub.com (Semen Trygubenko / =?utf-8?B?0KHQtdC80LXQvSDQotGA0LjQs9GD0LHQtdC9?= =?utf-8?B?0LrQvg==?=) Date: Tue, 11 Nov 2014 12:01:35 +0000 Subject: [Haskell-cafe] cabal keeps relinking In-Reply-To: <545D36AF.2090208@nh2.me> References: <20141107153549.GD64515@inanna.trygub.com> <545D0E14.50306@nh2.me> <20141107200929.GA67778@inanna.trygub.com> <545D36AF.2090208@nh2.me> Message-ID: <20141111120135.GB19364@inanna.trygub.com> On Fri, Nov 07, 2014 at 10:16:31PM +0100, Niklas Hamb?chen wrote: > Could you detail how cabal relinks for you, e.g. with some cabal -v2 / > -v3 output? The -vN outputs are verbose, so I ended up creating a minimalistic cabal package config that illustrates the problem (attached for reference ? see cabalTest.tar.gz). This is how the non-verbose outputs look like for builds on FreeBSD: $ cabal build Package has never been configured. Configuring with default flags. If this fails, please run configure manually. Resolving dependencies... Configuring cabalTest-0.1.0.0... Building cabalTest-0.1.0.0... Preprocessing library cabalTest-0.1.0.0... [1 of 1] Compiling CabalTest ( src/CabalTest.hs, dist/build/CabalTest.o ) In-place registering cabalTest-0.1.0.0... Preprocessing executable 'cabalTest' for cabalTest-0.1.0.0... [1 of 2] Compiling CabalTest ( src/CabalTest.hs, dist/build/cabalTest/cabalTest-tmp/CabalTest.o ) [2 of 2] Compiling Main ( src/cabalTest.hs, dist/build/cabalTest/cabalTest-tmp/Main.o ) Linking dist/build/cabalTest/cabalTest ... $ cabal clean cleaning... $ cabal test Package has never been configured. Configuring with default flags. If this fails, please run configure manually. Resolving dependencies... Configuring cabalTest-0.1.0.0... Building cabalTest-0.1.0.0... Preprocessing library cabalTest-0.1.0.0... [1 of 1] Compiling CabalTest ( src/CabalTest.hs, dist/build/CabalTest.o ) In-place registering cabalTest-0.1.0.0... Preprocessing executable 'cabalTest' for cabalTest-0.1.0.0... [1 of 2] Compiling CabalTest ( src/CabalTest.hs, dist/build/cabalTest/cabalTest-tmp/CabalTest.o ) [2 of 2] Compiling Main ( src/cabalTest.hs, dist/build/cabalTest/cabalTest-tmp/Main.o ) Linking dist/build/cabalTest/cabalTest ... Preprocessing test suite 'CabalTestTest' for cabalTest-0.1.0.0... [1 of 1] Compiling Main ( test/cabalTest.hs, dist/build/CabalTestTest/CabalTestTest-tmp/Main.o ) Linking dist/build/CabalTestTest/CabalTestTest ... Running 1 test suites... Test suite CabalTestTest: RUNNING... Test suite CabalTestTest: PASS Test suite logged to: dist/test/cabalTest-0.1.0.0-CabalTestTest.log 1 of 1 test suites (1 of 1 test cases) passed. and then for rebuilds: $ cabal build Building cabalTest-0.1.0.0... Preprocessing library cabalTest-0.1.0.0... In-place registering cabalTest-0.1.0.0... Preprocessing executable 'cabalTest' for cabalTest-0.1.0.0... Linking dist/build/cabalTest/cabalTest ... Preprocessing test suite 'CabalTestTest' for cabalTest-0.1.0.0... Linking dist/build/CabalTestTest/CabalTestTest ... $ cabal test Building cabalTest-0.1.0.0... Preprocessing library cabalTest-0.1.0.0... In-place registering cabalTest-0.1.0.0... Preprocessing executable 'cabalTest' for cabalTest-0.1.0.0... Linking dist/build/cabalTest/cabalTest ... Preprocessing test suite 'CabalTestTest' for cabalTest-0.1.0.0... Linking dist/build/CabalTestTest/CabalTestTest ... Running 1 test suites... Test suite CabalTestTest: RUNNING... Test suite CabalTestTest: PASS Test suite logged to: dist/test/cabalTest-0.1.0.0-CabalTestTest.log 1 of 1 test suites (1 of 1 test cases) passed. Then I ran the following five commands: cabal clean cabal build cabal test cabal build cabal test three times --- first without, then with -v2 and -v3, on two platforms. The outputs are here: http://trygub.com/download/cabalTest-FreeBSD.out.gz http://trygub.com/download/cabalTest-Linux.out.gz The behaviour is different on Linux and FreeBSD. This is the diff of the non-verbose outputs: 10a11 > [1 of 1] Compiling CabalTest ( src/CabalTest.hs, dist/build/CabalTest.p_o ) 14a16,17 > [1 of 2] Compiling CabalTest ( src/CabalTest.hs, dist/build/cabalTest/cabalTest-tmp/CabalTest.p_o ) > [2 of 2] Compiling Main ( src/cabalTest.hs, dist/build/cabalTest/cabalTest-tmp/Main.p_o ) 25d27 < Linking dist/build/cabalTest/cabalTest ... 27c29 < [1 of 1] Compiling Main ( test/cabalTest.hs, dist/build/CabalTestTest/CabalTestTest-tmp/Main.o ) --- > [1 of 1] Compiling Main ( test/cabalTest.hs, dist/build/CabalTestTest/CabalTestTest-tmp/Main.p_o ) 39d40 < Linking dist/build/cabalTest/cabalTest ... 41d41 < Linking dist/build/CabalTestTest/CabalTestTest ... 47d46 < Linking dist/build/cabalTest/cabalTest ... 49d47 < Linking dist/build/CabalTestTest/CabalTestTest ... So it seems that what I've observed is FreeBSD-specific ? FreeBSD rebuild outputs have extra "Linking ..." messages in them? Many thanks for your help, Semen PS Linux $ cabal --version cabal-install version 1.18.0.2 using version 1.18.1.2 of the Cabal library FreeBSD $ cabal --version cabal-install version 1.20.0.3 using version 1.20.0.2 of the Cabal library -- ????? ?????????? http://trygub.com -------------- next part -------------- A non-text attachment was scrubbed... Name: cabalTest.tar.gz Type: application/gzip Size: 974 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 181 bytes Desc: not available URL: From qdunkan at gmail.com Tue Nov 11 15:53:59 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 11 Nov 2014 07:53:59 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141111073857.1AFCA276C41@mail.avvanta.com> References: <20141111073857.1AFCA276C41@mail.avvanta.com> Message-ID: On Mon, Nov 10, 2014 at 11:38 PM, Donn Cave wrote: > Maybe they don't! I guess it isn't so much about exactly what you were > up to, but for the sake of getting to whether there's an issue here for > the tutorial, I wrote up a little example program, with CChar and Char. > The commented alternatives work as well, at least it looks fine to me. ... > - that means the Storable instance in question is CChar, and it looks > to me like poke reliably writes exactly one byte in this case, > whatever value is supplied (I also tried Int.) I think Int is probably unsafe too, in theory if not in practice. > - one might very well manage to keep all the poking to t fields in > the T Storable instance - that's what I'd expect the tutorial > to focus on. Not that it makes any great difference, but I'm just > saying that the "ypoke" function in the example is there purely > for the purpose of testing that Char/CChar thing you're talking > about, and would be somewhat outside what I see as core usage. Yes, it would be safe to say that all haskell data types which are serializable to C should have only C types. That also avoids the problem. However, you have to convert between haskell and C at some point, and that means you wind up with C and haskell duplicates of all records, so each one is actually expressed in 3 places: the C struct, the haskell "CType" record, and the haskell type record. To me it seemed the logical place to do haskell to C type conversions was in the poke method itself, but that's because I didn't think about the corruption thing. You might think it's obvious, but most type errors are obvious. People do obviously dumb things all the time, and the nice thing about a type checker is that we get a compile error, not memory corruption. Another reason you wind up with Storable instances of non-CType records is Data.Vector.Storable. It's very tempting to simply reuse that to pass to C, and maybe it's initially fine because it has Ints or Word32s or something "safe", but then one day 2 years later someone who doesn't know about that adds a Char field and now you're in trouble. > ypoke :: Char -> Char -> Char -> IO T > ypoke a b c = alloca $ \ tp -> do > (#poke struct t, a) tp a > (#poke struct t, b) tp b > (#poke struct t, c) tp c > peek tp This is corrupting memory, since sizeOf 'c' == 4. Like I said, it will probably look like it works because it's usually just overwriting adjacent fields or perhaps alignment padding or maybe it's "safe" if it's on the stack, but you are likely to get mysterious crashes under load. Try changing the order of the pokes and see what happens. I have to say I'm a bit surprised to be arguing for type safety vs. "just remember to do the right thing and you won't get memory corruption" on a haskell list :) From qdunkan at gmail.com Tue Nov 11 16:57:48 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 11 Nov 2014 08:57:48 -0800 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) Message-ID: I've been using these functions lately: try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) try action alternative = maybe alternative (return . Just) =<< action tries :: Monad m => [m (Maybe a)] -> m (Maybe a) tries = foldr try (return Nothing) It's sort of like (<|>) on Maybe, or MonadPlus, but within a monad. It seems like the sort of thing that should be already available, but hoogle shows nothing. I think 'm' has to be a monad, and I can't figure out how to generalize the Maybe to MonadPlus or Alternative. It's sort of a mirror image to another function I use a lot: justm :: Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm op1 op2 = maybe (return Nothing) op2 =<< op1 ... which is just MaybeT for when I can't be bothered to put runMaybeT and lifts and hoists on everything. So you could say 'try' is like MaybeT with the exceptional case reversed. Is 'try' just the instantiation of some standard typeclass, or is it its own thing? From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 11 17:18:56 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 11 Nov 2014 17:18:56 +0000 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: Message-ID: <20141111171856.GM31823@weber> On Tue, Nov 11, 2014 at 08:57:48AM -0800, Evan Laforge wrote: > try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) > try action alternative = maybe alternative (return . Just) =<< action Looks like the MonadPlus instance for MaybeT to me runMaybeT $ MaybeT (print "first" >> return (Just 1)) `mplus` MaybeT (print "second" >> return (Just 2)) Just 1 runMaybeT $ MaybeT (print "first" >> return Nothing) `mplus` MaybeT (print "second" >> return (Just 2)) "first" "second" Just 2 Tom From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 11 17:20:35 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 11 Nov 2014 17:20:35 +0000 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: <20141111171856.GM31823@weber> References: <20141111171856.GM31823@weber> Message-ID: <20141111172035.GN31823@weber> On Tue, Nov 11, 2014 at 05:18:56PM +0000, Tom Ellis wrote: > On Tue, Nov 11, 2014 at 08:57:48AM -0800, Evan Laforge wrote: > > try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) > > try action alternative = maybe alternative (return . Just) =<< action > > Looks like the MonadPlus instance for MaybeT to me > > runMaybeT $ MaybeT (print "first" >> return (Just 1)) > `mplus` MaybeT (print "second" >> return (Just 2)) > > Just 1 I mistranscribed the output. The output is "first" Just 1 From donn at avvanta.com Tue Nov 11 17:35:06 2014 From: donn at avvanta.com (Donn Cave) Date: Tue, 11 Nov 2014 09:35:06 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141111173506.B7B3FF393D@mail.avvanta.com> quoth Evan Laforge ... > Yes, it would be safe to say that all haskell data types which are > serializable to C should have only C types. That also avoids the > problem. However, you have to convert between haskell and C at some > point, and that means you wind up with C and haskell duplicates of all > records, so each one is actually expressed in 3 places: the C struct, > the haskell "CType" record, and the haskell type record. That could happen ... I suppose there's no one way to do it that fits every application, but often enough I can make do with the Haskell "CTYpe" record, and it gives me a Storable value that has a valid type enforced relationship to the C struct. You wouldn't always need or want a Haskell version of your C struct, per se, but if you do. > Another reason you wind up with Storable instances of non-CType > records is Data.Vector.Storable. It's very tempting to simply reuse > that to pass to C, and maybe it's initially fine because it has Ints > or Word32s or something "safe", but then one day 2 years later someone > who doesn't know about that adds a Char field and now you're in > trouble. Data.Vector.Storable is a new one on me! (I see it's in the non-portable, experimental category, so it figures.) The documentation I'm looking at seems to be saying it wouldn't be "instantiated" for Char, though? >> ypoke :: Char -> Char -> Char -> IO T >> ypoke a b c = alloca $ \ tp -> do >> (#poke struct t, a) tp a >> (#poke struct t, b) tp b >> (#poke struct t, c) tp c >> peek tp > > This is corrupting memory, since sizeOf 'c' == 4. Like I said, it > will probably look like it works because it's usually just overwriting > adjacent fields or perhaps alignment padding or maybe it's "safe" if > it's on the stack, but you are likely to get mysterious crashes under > load. Try changing the order of the pokes and see what happens. Ah, you're right, a final poke to offset 0 overwrites everything. In retrospect I ... don't know what I was thinking! Donn From qdunkan at gmail.com Tue Nov 11 18:55:22 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 11 Nov 2014 10:55:22 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141111173506.B7B3FF393D@mail.avvanta.com> References: <20141111173506.B7B3FF393D@mail.avvanta.com> Message-ID: On Tue, Nov 11, 2014 at 9:35 AM, Donn Cave wrote: > That could happen ... I suppose there's no one way to do it that fits > every application, but often enough I can make do with the Haskell > "CTYpe" record, and it gives me a Storable value that has a valid type > enforced relationship to the C struct. You wouldn't always need or > want a Haskell version of your C struct, per se, but if you do. True, but... consider Bool, with no corresponding C type. Just picking something like CUChar is inconvenient and ugly on the haskell side. > Data.Vector.Storable is a new one on me! (I see it's in the non-portable, > experimental category, so it figures.) The documentation I'm looking at > seems to be saying it wouldn't be "instantiated" for Char, though? It is actually, it's perfectly valid to have a vector of Chars. More importantly, you can have a vector of records that include Storable types. It's an acceptable use of Storable, I just think the "pun" where Storable for haskell types is the same as the Storable for C types is unfortunate. Anyway, in the big picture, I think hsc2hs is just too low level. We shouldn't be having to manually poke structs at all, and it's fundamentally dangerous even if you use all C types because there's no typechecking. Nothing will help you when someone updates the struct and forgets to update the Storable instance. If I were starting again (or advising someone who was starting from scratch), I'd try really hard to find something that directly generates marshalling code from the .h file, perhaps c2hs can do that. From mail at nh2.me Tue Nov 11 19:28:26 2014 From: mail at nh2.me (=?UTF-8?B?TmlrbGFzIEhhbWLDvGNoZW4=?=) Date: Tue, 11 Nov 2014 20:28:26 +0100 Subject: [Haskell-cafe] cabal keeps relinking In-Reply-To: <20141111120135.GB19364@inanna.trygub.com> References: <20141107153549.GD64515@inanna.trygub.com> <545D0E14.50306@nh2.me> <20141107200929.GA67778@inanna.trygub.com> <545D36AF.2090208@nh2.me> <20141111120135.GB19364@inanna.trygub.com> Message-ID: <5462635A.1030200@nh2.me> Ok, so it seems like it works on Linux, but not FreeBSD. To explain the situation a little bit: The compiled object files (.o) are linked together in an archive file (.a) by the `ar` program (similar to `tar`). The file entries in the .a file by default contain timestamps of the files, which usually means the mtime (last modification time). The build only looks at the .a file as a whole, and if its contents changed from the last build, it has to relink. Of course if a timestamp inside the .a changed, that's treated as "the .a file is different". Newer versions of `ar` have a -D option to avoid putting the mtimes of the .o files into the archive. But not all platforms supported by GHC/cabal support this flag. That's why we implemented a manual method to wipe the timestamps (set them to 0), so that they can no longer have an effect on the build. Seems like that doesn't work for FreeBSD. That's a shame, because we did take special care to make sure that it works cross-platform. You could help debug it: First, create an issue on cabal's Github so that we can track the bug, and explain the problem there and paste the output. Then try to find the craeated .a file (the -v outputs should help you where it is, something like libHSyourlibrary.a or similar), and observe how its contents change across different builds (you could use `cmp` to check if the files are byte-identical or something like `diff -u <(xxd firstbuild.a) <(xxd secondbuild.a)` to view the contents as a hex diff). Then try to see if this program I wrote: http://hackage.haskell.org/package/ar-timestamp-wiper makes the two .a files byte-identical. That will probably help us find the issue and get relinking-avoidance also on the BSDs. On 11/11/14 13:01, Semen Trygubenko / ????? ?????????? wrote: > So it seems that what I've observed is FreeBSD-specific ? FreeBSD rebuild outputs have extra "Linking ..." messages in them? From mail at nh2.me Tue Nov 11 19:37:23 2014 From: mail at nh2.me (=?windows-1252?Q?Niklas_Hamb=FCchen?=) Date: Tue, 11 Nov 2014 20:37:23 +0100 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: <20141110194605.2C1CCF3952@mail.avvanta.com> Message-ID: <54626573.6000702@nh2.me> On 11/11/14 06:55, Evan Laforge wrote: > ... memory corruption. I don't know if it's a common mistake, > but I sure made it You're definitely not alone here. Took me over a day to find, and it was just a 500 lines application. From llee454 at gmail.com Tue Nov 11 20:59:50 2014 From: llee454 at gmail.com (Larry Lee) Date: Tue, 11 Nov 2014 15:59:50 -0500 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: References: Message-ID: <546278C6.1040300@gmail.com> Hi I have a very simple problem. I have a class and want to define a function in that class that returns a different instance of the same class. I tried accomplishing this as follows: class A a where f :: A b => a -> b This fails however when I try to instantiate it. For example: instance A String where f x = x I get an error message that makes absolutely no sense to me: src/CSVTree.hs:12:9: Could not deduce (b ~ [Char]) from the context (A b) bound by the type signature for f :: A b => String -> b at src/CSVTree.hs:12:3-9 `b' is a rigid type variable bound by the type signature for f :: A b => String -> b at src/CSVTree.hs:12:3 In the expression: x In an equation for `f': f x = x In the instance declaration for `A String' make: *** [compile] Error 1 Can someone please explain: how I can achieve my goal; and why my code is failing; simply and in plain English. Thanks, Larry From k-bx at k-bx.com Tue Nov 11 20:48:35 2014 From: k-bx at k-bx.com (Konstantine Rybnikov) Date: Tue, 11 Nov 2014 22:48:35 +0200 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: Larry, By your definition f x = x this function returns whatever it got in it's argument, thus: 1. compiler infers that it's argument is of type String from class-definition 2. String is actually a type-synonim for list of chars type String = [Char] 3. So now, on one hand function is returning something of a concrete type [Char], and on the other (from class-definition) it should be some type only restricted by operations on type-class. Regarding your question on "how to do things properly" -- I'm not sure what exactly are you trying to achieve. Could you describe a problem you're trying to solve? If you want to return something of type b, which is only constrainted by being an instance of a type-class A, then you need to create it with a function defined in class A. But since only function is f, it's not enough. Here's an example of solution for the original "return something of another instance" problem: {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} class A a where f :: A b => a -> b def :: a instance A Int where f x = def def = 4 instance A String where f x = def def = "asd" main :: IO () main = print $ (f "asd" :: Int) Cheers. On Tue, Nov 11, 2014 at 10:59 PM, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Tue Nov 11 21:41:09 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 11 Nov 2014 13:41:09 -0800 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: <20141111171856.GM31823@weber> References: <20141111171856.GM31823@weber> Message-ID: On Tue, Nov 11, 2014 at 9:18 AM, Tom Ellis wrote: > On Tue, Nov 11, 2014 at 08:57:48AM -0800, Evan Laforge wrote: >> try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) >> try action alternative = maybe alternative (return . Just) =<< action > > Looks like the MonadPlus instance for MaybeT to me > > runMaybeT $ MaybeT (print "first" >> return (Just 1)) > `mplus` MaybeT (print "second" >> return (Just 2)) Ah, so it looks like it does exist, but requires explicit running and wrapping, e.g. compare to: try (print "first" >> return (Just 1)) $ print "second" >> return (Just 2) I guess it's like 'justm' then, which is also just MaybeT, but with less typing. Thanks! From t at tmh.cc Tue Nov 11 21:49:13 2014 From: t at tmh.cc (Taylor Hedberg) Date: Tue, 11 Nov 2014 13:49:13 -0800 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: The caller of your function f, rather than the implementation of f, gets to decide which instance of A f should return. In other words, f's implementation must be polymorphic in its return type. Your example f x = x does not satisfy that property. That implementation has type f :: A a => a -> a, not the required type f :: (A a, A b) => a -> b. The error message is saying that, from the class definition, GHC has deduced that f must return a value of type A b => b, but your implementation is returning a String (a.k.a. [Char]) instead. The notation b ~ [Char] means "b is equivalent to [Char]". On Tue, Nov 11, 2014 at 12:59 PM, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.gibiansky at gmail.com Tue Nov 11 20:10:47 2014 From: andrew.gibiansky at gmail.com (Andrew Gibiansky) Date: Tue, 11 Nov 2014 12:10:47 -0800 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: When you declare a type signature such as f :: C x => a -> b there is an implicit "forall": f :: forall x. C x => a -> x That is, the type signature must hold *for all* x such that C x holds. However, in your case, it only holds for String ? while A String does hold, that is irrelevant, because the type signature states that it must hold for *any* x such that A x that the caller wants. To put it another way, the caller decides the "b" in that type signature, not the function implementation. What you want is something like f :: exists x. C x => a -> x so that f will return some unknown value such that you know it is an instance of C x. Hope that helps, Andrew On Tue, Nov 11, 2014 at 12:59 PM, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From hjgtuyl at chello.nl Tue Nov 11 20:38:20 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Tue, 11 Nov 2014 21:38:20 +0100 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: On Sat, 08 Nov 2014 16:54:06 +0100, Alex Petrov wrote: > I've recently started working on Haskell FFI Tutorial [1]. : > [1] https://github.com/ifesdjeen/haskell-ffi-tutorial I have added a link to this at https://www.haskell.org/haskellwiki/Foreign_Function_Interface#Links Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From frank at fstaals.net Tue Nov 11 20:46:59 2014 From: frank at fstaals.net (Frank Staals) Date: Tue, 11 Nov 2014 21:46:59 +0100 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> (Larry Lee's message of "Tue, 11 Nov 2014 15:59:50 -0500") References: <546278C6.1040300@gmail.com> Message-ID: Larry Lee writes: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b The only possible implementation for function f will be const undefined. Your function f promises that given a value of type a, it can return a value of *any* type b, as long as b is an instance of typeclass A. So, once we are given a value of type a, we have to produce a value of type b, however, we don't know what type b is! The only thing that we know about things of type b is that they are an instance of A. This is not enough information to be able to produce something of type b. > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > See the above: you are producing of type String. However, according to the type signature, you should be able to produce something of an arbitrary type b. Clearly that is not possible. I am guessing that once you know the type a, you also know what the output type b will be. If that is the case then you can use type families: class A a where type B a f :: a -> B a instance A String where type B String = String f = id Hope this helps. Regards, -- - Frank From jochem at functor.nl Tue Nov 11 20:46:11 2014 From: jochem at functor.nl (Jochem Berndsen) Date: Tue, 11 Nov 2014 21:46:11 +0100 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: <54627593.3070100@functor.nl> Hi Larry, On 11/11/2014 09:59 PM, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that > returns a different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > f has type (A a, A b) => a -> b. Both a and b can be thosen by the caller. If you try to create an instance of A like you did, this will not type check, as you have only provided a function of type String -> String, whereas a function of type A b => String -> b (for *all* b) is required. I hope that clears things up a little. Thanks, Jochem -- Jochem Berndsen | jochem at functor.nl From jmartin at eecs.berkeley.edu Tue Nov 11 20:58:17 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Tue, 11 Nov 2014 12:58:17 -0800 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: First, there is an even simpler case that won't work: class A a where foo :: a -> b The question is what is 'b'. According to this b can be anything not something specific. If you want 'b' to be something specific in must appear as part of the type class declaration. To do what you want to do, you could use the extension MultiParamTypeClasses. class A a class (A a, A b) => B a b where foo :: a -> b instance A Int instance B Int Int where foo = id Second, Haskell does not by default allow for type synonyms in instance declarations. String is a type synonym of [Char]. If you want to use String in instance declarations use the extension TypeSynonymInstances and FlexibleInstances. instance A String instance A String String where foo = id James On Tue, Nov 11, 2014 at 12:59 PM, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From trupill at gmail.com Tue Nov 11 21:11:08 2014 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Tue, 11 Nov 2014 22:11:08 +0100 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: The problem is that the type of f is f :: (A a, A b) => a -> b This means that given an 'a', you need to create a function which works for *any* b in A. However, the function you implement is of type `f :: String -> String`, not of type `f :: A b => String -> b`, as needed. If you were to implement the function in that way, you could use: class A a where f :: a -> a 2014-11-11 21:59 GMT+01:00 Larry Lee : > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 11 22:19:55 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 11 Nov 2014 22:19:55 +0000 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: <20141111221955.GP31823@weber> On Tue, Nov 11, 2014 at 03:59:50PM -0500, Larry Lee wrote: > I have a very simple problem. > I have a class and want to define a function in that class that > returns a different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x The `f` that you defined has type `String -> String`. However, given the definition of the class `A` it should have been of type `A b => String -> b`. What exactly are you trying to do here? This is probably not the way to go about it. Tom From ivan.miljenovic at gmail.com Tue Nov 11 23:46:23 2014 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Wed, 12 Nov 2014 10:46:23 +1100 Subject: [Haskell-cafe] A Very Simple Type Class Question In-Reply-To: <546278C6.1040300@gmail.com> References: <546278C6.1040300@gmail.com> Message-ID: On 12 November 2014 07:59, Larry Lee wrote: > Hi > > I have a very simple problem. > I have a class and want to define a function in that class that returns a > different instance of the same class. > > I tried accomplishing this as follows: > > class A a where > f :: A b => a -> b This type signature says "I can convert my instance of type `a' to any instance of this type class `b'... as chosen by the *caller* of this function". i.e. if you have instances for Foo, Bar and Baz, then "f Foo" isn't fixed to just Bar: the caller can choose any instance it likes (which is usually not what you want). > > > This fails however when I try to instantiate it. For example: > > instance A String where > f x = x This instance only works if the `b' in the type signature of `f' is also String, rather than being chosen by the caller. > > > I get an error message that makes absolutely no sense to me: > > src/CSVTree.hs:12:9: > Could not deduce (b ~ [Char]) > from the context (A b) > bound by the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3-9 > `b' is a rigid type variable bound by > the type signature for f :: A b => String -> b > at src/CSVTree.hs:12:3 > In the expression: x > In an equation for `f': f x = x > In the instance declaration for `A String' > make: *** [compile] Error 1 This is saying "The instance definition requires the `b' type to be [Char] (i.e. String), but there's no requirement/ability in the definition of the type to have such a constraint/requirement." > > Can someone please explain: how I can achieve my goal; and why my code is > failing; simply and in plain English. Depending on what exactly you want, there are three options: * If you want each type to convert to itself, then change the type of `f' to be just "a -> a" * If you want a one-to-many mapping (i.e. given `a', I know there's precisely one possible value of `b'), then use either Multi-Param Type Classes (MPTCs) + Functional Dependencies or else an associated Type Family alias within the type class to denote that relationship. * If you have a many-to-many relationship (Foo can convert to Foo or Baz, Bar can convert only to Baz and Baz can convert to anything), then use an MPTC (though this will in general require an instance for every possible pairing). > > Thanks, > Larry > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From kannan at cakoose.com Wed Nov 12 00:48:13 2014 From: kannan at cakoose.com (Kannan Goundan) Date: Wed, 12 Nov 2014 00:48:13 +0000 (UTC) Subject: [Haskell-cafe] Representing record subtypes, sort of. References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> Message-ID: Karl Voelker karlv.net> writes: > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE GADTs #-} > {-# LANGUAGE KindSignatures #-} > module FS where > > type Date = String > > data FileKind = FILE | FOLDER > > data Entry (k :: FileKind) where > File :: String -> Date -> Int -> Entry FILE > Folder :: String -> String -> Entry FOLDER This is a little beyond my Haskell knowledge. What would the function signatures look like? Here are my guesses: listFolder :: Path -> [Entry ?] createFolder :: Path -> Entry FOLDER createFile :: Path -> Entry FOLDER Also, lets say I wanted to just get the "id" fields from a list of `Entry` values. Can someone help me fill in the blanks here? l :: [Entry ?] let ids = map (?) l From gale at sefer.org Wed Nov 12 02:43:21 2014 From: gale at sefer.org (Yitzchak Gale) Date: Wed, 12 Nov 2014 04:43:21 +0200 Subject: [Haskell-cafe] Using multiple versions of the Haskell Platform on Windows Message-ID: The win-hp-path project provides the use-hp command, which makes it easy to switch between different versions of Haskell Platform on Windows. https://github.com/ygale/win-hp-path We are using it for running cabal and GHC in command prompt windows. In particular, we can also use it in build scripts used by the build management team who are not Haskell programmers. Please let me know if you can use this in more complex dev environments, or if you have suggestions about how it could be enhanced to do that. Pull requests are welcome. Thanks, Yitz From qdunkan at gmail.com Wed Nov 12 03:40:00 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 11 Nov 2014 19:40:00 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <54626573.6000702@nh2.me> References: <20141110194605.2C1CCF3952@mail.avvanta.com> <54626573.6000702@nh2.me> Message-ID: On Tue, Nov 11, 2014 at 11:37 AM, Niklas Hamb?chen wrote: > Took me over a day to find, and it was just a 500 lines application. More than a year, maybe two in my case, and was probably around 50k lines at the time, though only 1k in the FFI. It wouldn't show up in tests, except when it did, so I wrote all manner of special test frameworks to try to reproduce it reliably, nothing did. valgrind doesn't help with this kind of problem. I must have looked straight at the bad code a hundred times at least. Anyway it's a lesson I won't soon forget. From donn at avvanta.com Wed Nov 12 07:37:49 2014 From: donn at avvanta.com (Donn Cave) Date: Tue, 11 Nov 2014 23:37:49 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141112073749.E1BAE93C43@mail.avvanta.com> quoth Evan Laforge ... > Anyway, in the big picture, I think hsc2hs is just too low level. We > shouldn't be having to manually poke structs at all, and it's > fundamentally dangerous even if you use all C types because there's no > typechecking. Nothing will help you when someone updates the struct > and forgets to update the Storable instance. If I were starting again > (or advising someone who was starting from scratch), I'd try really > hard to find something that directly generates marshalling code from > the .h file, perhaps c2hs can do that. I'm not up for generating anything directly from a .h file, but just for fun I put a little time today into an hsc alternative with a little more type safety. It works to a certain extent with integral types, because I can determine the size of the C field and assign an appropriate Haskell foreign integral type. I used it to generate a module for struct termios, for which I've been using hsc2hs, and it did better than hsc2hs in an unexpected way - hsc2hs #type maps "unsigned long" to "Word32", but on MacOS X the field size is 8 bytes. Then I make a raft of peek and poke functions that take the native Haskell values that you specify, and convert them to the appropriate foreign types. This is based on a descriptor file where you specify the fields you want to use, your Haskell name and type for each, and whether it's integral or whatever. Integral or whatever is where the joy leaks out of the concept, though. I'd bet a quarter that at least one in every four .hsc files contains some custom peeking and poking for a struct field, stuff you'd never anticipate. Full support for all types seems like a nearly unbounded problem. hsc2hs could do essentially what I'm talking about, if it could tell you the size of a field. Then you could declare the foreign types like termiosC_lflag :: (#appendfieldsize Word struct termios, c_lflag) which would expand to termiosC_lflag :: Word64 (fieldsize would be sizeof(x->c_lflag) * 8) This would give us foreign types based on the C declaration. You'd have to do the conversions yourself where you want to use native types, in this scenario. Donn From frank at fstaals.net Wed Nov 12 08:56:35 2014 From: frank at fstaals.net (Frank Staals) Date: Wed, 12 Nov 2014 09:56:35 +0100 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: (Kannan Goundan's message of "Wed, 12 Nov 2014 00:48:13 +0000 (UTC)") References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> Message-ID: <87389o23wc.fsf@Shanna.FStaals.net> Kannan Goundan writes: > Karl Voelker karlv.net> writes: > >> {-# LANGUAGE DataKinds #-} >> {-# LANGUAGE GADTs #-} >> {-# LANGUAGE KindSignatures #-} >> module FS where >> >> type Date = String >> >> data FileKind = FILE | FOLDER >> >> data Entry (k :: FileKind) where >> File :: String -> Date -> Int -> Entry FILE >> Folder :: String -> String -> Entry FOLDER > > This is a little beyond my Haskell knowledge. What would the function > signatures look like? Here are my guesses: > > listFolder :: Path -> [Entry ?] Unfortunately, we cannot have our cake and eat it as well. Entry FILE and Entry FOLDER are now different types, and hence you cannot construct a list containing both. In other words; we cannot really fill in the ? in the type signature (or at least not that I'm aware of). Either we use Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry FOLDER)] or you have to create some existential type around an Entry again, i.e. data SomeEntry where SomeEntry :: Entry k -> SomeEntry listFolder :: Path -> [SomeEntry] You can get the file kind back by pattern matching again. > createFolder :: Path -> Entry FOLDER > createFile :: Path -> Entry FOLDER the second one should produce something of type Entry FILE. > Also, lets say I wanted to just get the "id" fields from a list of `Entry` > values. Can someone help me fill in the blanks here? > > l :: [Entry ?] > let ids = map (?) l This is basically the same issue as before. You cannot construct a list that contains both Entry FILE and Entry FOLDER values. We can use type classes together with the SomeEntry solution above though. ---- In general I like the fact that we can use the GADTs to obtain extra type level guarantees. However, working with lists (or other data structures) with them is a crime. I think for that, we need better support for working with hetrogenious collections. -- - Frank From tobias.pflug at gmx.net Wed Nov 12 09:45:15 2014 From: tobias.pflug at gmx.net (Tobias Pflug) Date: Wed, 12 Nov 2014 10:45:15 +0100 Subject: [Haskell-cafe] data analysis question Message-ID: <54632C2B.6000803@gmx.net> Hi, just the other day I talked to a friend of mine who works for an online radio service who told me he was currently looking into how best work with assorted usage data: currently 250 million entries as a 12GB in a csv comprising of information such as which channel was tuned in for how long with which user agent and what not. He accidentally ran into K and Q programming language (*1) which apparently work nicely for this as unfamiliar as it might seem. This certainly is not my area of expertise at all. I was just wondering how some of you would suggest to approach this with Haskell. How would you most efficiently parse such data evaluating custom queries ? Thanks for your time, Tobi [1] (http://en.wikipedia.org/wiki/K_(programming_language) [2] http://en.wikipedia.org/wiki/Q_(programming_language_from_Kx_Systems) From michael at snoyman.com Wed Nov 12 10:01:12 2014 From: michael at snoyman.com (Michael Snoyman) Date: Wed, 12 Nov 2014 10:01:12 +0000 Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> Message-ID: It's hard to answer without knowing what kinds of queries he's doing, but in the past, I've used csv-conduit to parse the raw data, convert the data to some Haskell ADT, and then used standard conduit processing to perform analyses in a streaming manner. On Wed Nov 12 2014 at 11:45:36 AM Tobias Pflug wrote: > Hi, > > just the other day I talked to a friend of mine who works for an online > radio service who told me he was currently looking into how best work > with assorted usage data: currently 250 million entries as a 12GB in a > csv comprising of information such as which channel was tuned in for how > long with which user agent and what not. > > He accidentally ran into K and Q programming language (*1) which > apparently work nicely for this as unfamiliar as it might seem. > > This certainly is not my area of expertise at all. I was just wondering > how some of you would suggest to approach this with Haskell. How would > you most efficiently parse such data evaluating custom queries ? > > Thanks for your time, > Tobi > > [1] (http://en.wikipedia.org/wiki/K_(programming_language) > [2] http://en.wikipedia.org/wiki/Q_(programming_language_from_Kx_Systems) > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From simons at cryp.to Wed Nov 12 10:21:20 2014 From: simons at cryp.to (Peter Simons) Date: Wed, 12 Nov 2014 11:21:20 +0100 Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> Message-ID: <87tx24hg7z.fsf@write-only.cryp.to> Hi Tobias, > A friend [is] currently looking into how best work with assorted > usage data: currently 250 million entries as a 12GB in a csv > comprising of information such as which channel was tuned in for how > long with which user agent and what not. as much as I love Haskell, the tool of choice for data analysis is GNU R, not so much because of the language, but simply because of the vast array of high-quality libraries that cover topics, like statistics, machine learning, visualization, etc. You'll find it at . If you'd want to analyze 12 GB of data in Haskell, you'd have to jump through all kinds of hoops just to load that CVS file into memory. It's possible, no doubt, but pulling it off efficiently requires a lot of expertise in Haskell that statistics guys don't necessarily have (and arguably they shouldn't have to). The package Rlang-QQ integrates R into Haskell, which might be a nice way to deal with this task, but I have no personal experience with that library, so I'm not sure whether this adds much value. Just my 2 cents, Peter From roma at ro-che.info Wed Nov 12 11:56:54 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 12 Nov 2014 06:56:54 -0500 Subject: [Haskell-cafe] data analysis question In-Reply-To: <87tx24hg7z.fsf@write-only.cryp.to> References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> Message-ID: <54634B06.2070809@ro-che.info> On 12/11/14 05:21, Peter Simons wrote: > If you'd want to analyze 12 GB of data in Haskell, you'd have to jump > through all kinds of hoops just to load that CVS file into memory. It's > possible, no doubt, but pulling it off efficiently requires a lot of > expertise in Haskell that statistics guys don't necessarily have (and > arguably they shouldn't have to). Well, with Haskell you don't have to load the whole data set into memory, as Michael shows. With R, on the other hand, you do. Besides, if you're not an R expert, and if the analysis you want to do is not readily available, it may be quite a pain to implement in R. As a simple example, I still don't know an acceptable way to write something like zipWith f (tail vec) vec in R. Roman From tobias.pflug at gmx.net Wed Nov 12 12:04:25 2014 From: tobias.pflug at gmx.net (Tobias Pflug) Date: Wed, 12 Nov 2014 13:04:25 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: <54634B06.2070809@ro-che.info> References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> Message-ID: <54634CC9.1040504@gmx.net> On 12.11.2014 12:56, Roman Cheplyaka wrote: > On 12/11/14 05:21, Peter Simons wrote: >> If you'd want to analyze 12 GB of data in Haskell, you'd have to jump >> through all kinds of hoops just to load that CVS file into memory. It's >> possible, no doubt, but pulling it off efficiently requires a lot of >> expertise in Haskell that statistics guys don't necessarily have (and >> arguably they shouldn't have to). > Well, with Haskell you don't have to load the whole data set into > memory, as Michael shows. With R, on the other hand, you do. > > That is exactly the thing that came to my mind thinking about R. I haven't actually used R myself but based on what I know and what some googling revealed all analysis would have to happen in-memory. PS: I could be wrong of course ;) From dominic at steinitz.org Wed Nov 12 12:41:09 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Wed, 12 Nov 2014 12:41:09 +0000 Subject: [Haskell-cafe] Presenting at Royal Holloway Colloquium Message-ID: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> All, I have been invited to give a TED style talk (20 mins) at the Royal Holloway Hewlett Packard Information Security Colloquium: https://www.royalholloway.ac.uk/isg/externalengagement/hpday.aspx. Now I could give an uncontroversial talk about Internet banking security using triple DES, role based access control, etc. but I am thinking about being controversial (I think that is in the spirit of TED). I?d like to say that the Information Security community is solving the wrong problems by e.g. performing security audits of code, developing tools for finding buffer overflows, etc. and what they should really be doing is encouraging development in languages that prevent this sort of behaviour. E.g. if openssl were written in Haskell, heartbleed (http://en.wikipedia.org/wiki/Heartbleed) would never have happened. What do people think about this? Are there other examples I can draw on? Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com From simons at cryp.to Wed Nov 12 14:21:53 2014 From: simons at cryp.to (Peter Simons) Date: Wed, 12 Nov 2014 15:21:53 +0100 Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> Message-ID: <87sihopkhq.fsf@write-only.cryp.to> Hi Roman, > With Haskell you don't have to load the whole data set into memory, > as Michael shows. With R, on the other hand, you do. Can you please point me to a reference to back that claim up? I'll offer [1] and [2] as a pretty good indications that you may not be entirely right about this. > Besides, if you're not an R expert, and if the analysis you want to do > is not readily available, it may be quite a pain to implement in R. Actually, implementing sophisticated queries in R is quite easy because the language was specifically designed for that kind of thing. If you have no experience in neither R nor Haskell, then learning R is *far* easier than learning Haskell is because it doesn't aim to be a powerful general-purpose programming language. It aims to be a powerful language for data analysis. Now, one *could* write a DSL in Haskell, of course, that matches R features and accomplishes data analysis tasks in a similarly convenient syntax, etc. But unfortunately no such library exists, and writing one is not trivial task. > I still don't know an acceptable way to write something like zipWith > f (tail vec) vec in R. Why would that be any trouble? What kind of solutions did you find and in what way were they unacceptable? Best regards, Peter [1] http://cran.r-project.org/web/packages/ff/index.html [2] http://cran.r-project.org/web/packages/bigmemory/index.html From the.dead.shall.rise at gmail.com Wed Nov 12 13:18:20 2014 From: the.dead.shall.rise at gmail.com (Mikhail Glushenkov) Date: Wed, 12 Nov 2014 14:18:20 +0100 Subject: [Haskell-cafe] Using multiple versions of the Haskell Platform on Windows In-Reply-To: References: Message-ID: Hi, On 12 November 2014 03:43, Yitzchak Gale wrote: > The win-hp-path project provides the use-hp command, > which makes it easy to switch between different versions > of Haskell Platform on Windows. > > https://github.com/ygale/win-hp-path Very nice! This should be added to the official installer. There's a ticket already: https://github.com/haskell/haskell-platform/issues/56 From jeffbrown.the at gmail.com Wed Nov 12 19:13:07 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Wed, 12 Nov 2014 11:13:07 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: <87389o23wc.fsf@Shanna.FStaals.net> References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: I am imagining an alternative idiom for heterogeneous treatment in which there is a single constructor, but the data type includes an attribute that is a dictionary keyed with function names, leading to values that are the corresponding code. It seems like that would have to be memory-wasteful, duplicating the code in every object, since Haskell does not permit pointers to a single code source, but maybe I'm wrong about that. On Wed, Nov 12, 2014 at 12:56 AM, Frank Staals wrote: > Kannan Goundan writes: > > > Karl Voelker karlv.net> writes: > > > >> {-# LANGUAGE DataKinds #-} > >> {-# LANGUAGE GADTs #-} > >> {-# LANGUAGE KindSignatures #-} > >> module FS where > >> > >> type Date = String > >> > >> data FileKind = FILE | FOLDER > >> > >> data Entry (k :: FileKind) where > >> File :: String -> Date -> Int -> Entry FILE > >> Folder :: String -> String -> Entry FOLDER > > > > This is a little beyond my Haskell knowledge. What would the function > > signatures look like? Here are my guesses: > > > > listFolder :: Path -> [Entry ?] > > Unfortunately, we cannot have our cake and eat it as well. Entry FILE > and Entry FOLDER are now different types, and hence you cannot construct > a list containing both. In other words; we cannot really fill in the ? > in the type signature (or at least not that I'm aware of). Either we use > Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry > FOLDER)] or you have to create some existential type around an Entry > again, i.e. > > data SomeEntry where > SomeEntry :: Entry k -> SomeEntry > > listFolder :: Path -> [SomeEntry] > > You can get the file kind back by pattern matching again. > > > createFolder :: Path -> Entry FOLDER > > createFile :: Path -> Entry FOLDER > > the second one should produce something of type Entry FILE. > > > Also, lets say I wanted to just get the "id" fields from a list of > `Entry` > > values. Can someone help me fill in the blanks here? > > > > l :: [Entry ?] > > let ids = map (?) l > > This is basically the same issue as before. You cannot construct a list > that contains both Entry FILE and Entry FOLDER values. We can use type > classes together with the SomeEntry solution above though. > > ---- > > In general I like the fact that we can use the GADTs to obtain extra > type level guarantees. However, working with lists (or other data > structures) with them is a crime. I think for that, we need better > support for working with hetrogenious collections. > > -- > > - Frank > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fe.kunzmann at gmail.com Wed Nov 12 19:36:04 2014 From: fe.kunzmann at gmail.com (Felix Kunzmann) Date: Wed, 12 Nov 2014 20:36:04 +0100 Subject: [Haskell-cafe] IO monads, stream handles, and type inference In-Reply-To: References: Message-ID: SendOSC is a type class and not a data type (or type synonym or newtype). 2014-11-11 5:23 GMT+01:00 Rohan Drape : > > *How to read the "instances" portion of Hackage documentation?* > > is there some reason to use hosc-0.13? > > the hackage documentation for 0.13 is very obscure on this point > > & for complicated reasons not much to do with hosc > > > I understand the middle two clauses: that io should be of type MonadIO, > and > > t should be of type Transport. > > hosc-0.15 says only "(Transport t, MonadIO io) => SendOSC (ReaderT t io)" > > so you may understand all there is to understand? > > best, > rd > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From 0slemi0 at gmail.com Wed Nov 12 22:07:51 2014 From: 0slemi0 at gmail.com (Andras Slemmer) Date: Wed, 12 Nov 2014 23:07:51 +0100 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: Well, "try" is really doing two things: chaining Maybes, and then adding a monadic context: try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) try = liftM2 (<|>) (You could weaken the assumption by using (Applicative m) instead) "tries" is similar, only there is an intermediate "threading" step [m x] -> m [x]: tries :: Monad m => [m (Maybe a)] -> m (Maybe a) tries = liftM asum . sequence These are both special cases, they only rely on Maybe being an Alternative: try :: (Monad m, Alternative f) => m (f a) -> m (f a) -> m (f a) tries :: (Monad m, Alternative f) => [m (f a)] -> m (f a) If you *really* want to generalise you can even write this. ([] is also an unnecessary specialisation right?:)) tries :: (Monad m, Alternative f, Traversable t) => t (m (f a)) -> m (f a) "justm" is a bit different, as you rely on Maybe's concrete structure by using 'maybe'. However you can still generalise it if you really want to. The first thing to realise is because you are "binding" with an (a -> _) function you'll need to use the monadic structure of both 'm' and 'Maybe' to unpack-repack properly. The second is the need of n (m x) -> m (n x), which is Data.Traversable:mapM justm :: (Monad m, Monad n, Traversable n) => m (n a) -> (a -> m (n b)) -> m (n b) justm m f = m >>= liftM join . mapM f However if you ask me, these generalisations are completely useless in practice 99 out of a 100 times. Your original functions are way more discoverable and intuitive. Generalising just for the sake of generalising is rarely a good design practice when you write "real" software. Imho these abstractions only make sense when you are designing a library API and you want to make as few assumptions as you can about the user's calling context. On 11 November 2014 22:41, Evan Laforge wrote: > On Tue, Nov 11, 2014 at 9:18 AM, Tom Ellis > wrote: > > On Tue, Nov 11, 2014 at 08:57:48AM -0800, Evan Laforge wrote: > >> try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) > >> try action alternative = maybe alternative (return . Just) =<< action > > > > Looks like the MonadPlus instance for MaybeT to me > > > > runMaybeT $ MaybeT (print "first" >> return (Just 1)) > > `mplus` MaybeT (print "second" >> return (Just 2)) > > Ah, so it looks like it does exist, but requires explicit running and > wrapping, e.g. compare to: > > try (print "first" >> return (Just 1)) $ print "second" >> return (Just 2) > > I guess it's like 'justm' then, which is also just MaybeT, but with less > typing. > > Thanks! > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From markus.l2ll at gmail.com Wed Nov 12 22:17:19 2014 From: markus.l2ll at gmail.com (=?UTF-8?B?TWFya3VzIEzDpGxs?=) Date: Wed, 12 Nov 2014 23:17:19 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: <54632C2B.6000803@gmx.net> References: <54632C2B.6000803@gmx.net> Message-ID: Hi Tobias, What he could do is encode the column values to appropriate lengths of Word's to reduce the size -- to make it fit in ram. E.g listening times as seconds, browsers as categorical variables (in statistics terms), etc. If some of the columns are arbitrary length strings, then it seems possible to get 12GB down by more than half. If he doesn't know Haskell, then I'd suggest using another language. (Years ago I tried to do a bigger uni project in Haskell-- being a noob --and failed miserably.) On Nov 12, 2014 10:45 AM, "Tobias Pflug" wrote: > Hi, > > just the other day I talked to a friend of mine who works for an online > radio service who told me he was currently looking into how best work with > assorted usage data: currently 250 million entries as a 12GB in a csv > comprising of information such as which channel was tuned in for how long > with which user agent and what not. > > He accidentally ran into K and Q programming language (*1) which > apparently work nicely for this as unfamiliar as it might seem. > > This certainly is not my area of expertise at all. I was just wondering > how some of you would suggest to approach this with Haskell. How would you > most efficiently parse such data evaluating custom queries ? > > Thanks for your time, > Tobi > > [1] (http://en.wikipedia.org/wiki/K_(programming_language) > [2] http://en.wikipedia.org/wiki/Q_(programming_language_from_Kx_Systems) > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jmartin at eecs.berkeley.edu Wed Nov 12 22:26:49 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Wed, 12 Nov 2014 14:26:49 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: A potentially more elegant approach is using existential types. {-# LANGUAGE ExistentialQuantification #-} class IsFsEntry a where bar :: a -> String data FsFile = FsFile instance IsFsEntry FsFile where bar _ = "File" data FsFolder = FsFolder instance IsFsEntry FsFolder where bar _ = "Folder" data FsEntry = forall a . (IsFsEntry a) => MkFsEntry a https://gist.github.com/jcmartin/cfa5e28ba36574a7e68d James On Wed, Nov 12, 2014 at 11:13 AM, Jeffrey Brown wrote: > I am imagining an alternative idiom for heterogeneous treatment in which > there is a single constructor, but the data type includes an attribute that > is a dictionary keyed with function names, leading to values that are the > corresponding code. > > It seems like that would have to be memory-wasteful, duplicating the code > in every object, since Haskell does not permit pointers to a single code > source, but maybe I'm wrong about that. > > On Wed, Nov 12, 2014 at 12:56 AM, Frank Staals wrote: > >> Kannan Goundan writes: >> >> > Karl Voelker karlv.net> writes: >> > >> >> {-# LANGUAGE DataKinds #-} >> >> {-# LANGUAGE GADTs #-} >> >> {-# LANGUAGE KindSignatures #-} >> >> module FS where >> >> >> >> type Date = String >> >> >> >> data FileKind = FILE | FOLDER >> >> >> >> data Entry (k :: FileKind) where >> >> File :: String -> Date -> Int -> Entry FILE >> >> Folder :: String -> String -> Entry FOLDER >> > >> > This is a little beyond my Haskell knowledge. What would the function >> > signatures look like? Here are my guesses: >> > >> > listFolder :: Path -> [Entry ?] >> >> Unfortunately, we cannot have our cake and eat it as well. Entry FILE >> and Entry FOLDER are now different types, and hence you cannot construct >> a list containing both. In other words; we cannot really fill in the ? >> in the type signature (or at least not that I'm aware of). Either we use >> Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry >> FOLDER)] or you have to create some existential type around an Entry >> again, i.e. >> >> data SomeEntry where >> SomeEntry :: Entry k -> SomeEntry >> >> listFolder :: Path -> [SomeEntry] >> >> You can get the file kind back by pattern matching again. >> >> > createFolder :: Path -> Entry FOLDER >> > createFile :: Path -> Entry FOLDER >> >> the second one should produce something of type Entry FILE. >> >> > Also, lets say I wanted to just get the "id" fields from a list of >> `Entry` >> > values. Can someone help me fill in the blanks here? >> > >> > l :: [Entry ?] >> > let ids = map (?) l >> >> This is basically the same issue as before. You cannot construct a list >> that contains both Entry FILE and Entry FOLDER values. We can use type >> classes together with the SomeEntry solution above though. >> >> ---- >> >> In general I like the fact that we can use the GADTs to obtain extra >> type level guarantees. However, working with lists (or other data >> structures) with them is a crime. I think for that, we need better >> support for working with hetrogenious collections. >> >> -- >> >> - Frank >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Wed Nov 12 22:44:35 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Wed, 12 Nov 2014 23:44:35 +0100 Subject: [Haskell-cafe] Generating valid html Message-ID: <5463E2D3.7040305@power.com.pl> Hello list, I have a question. How to create a DSL for HTML generation, that would (statically) allow only valid HTML to be generated? Parent - child relations, valid attributes only. Or does such a DSL already exist, perhaps? -- Kind regards, Wojtek Narczynski From lambda.fairy at gmail.com Thu Nov 13 00:23:20 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Thu, 13 Nov 2014 13:23:20 +1300 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: On Thu, Nov 13, 2014 at 11:07 AM, Andras Slemmer <0slemi0 at gmail.com> wrote: > Well, "try" is really doing two things: chaining Maybes, and then adding a > monadic context: > try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) > try = liftM2 (<|>) > (You could weaken the assumption by using (Applicative m) instead) That's different to Evan's original function. Evan's solution short-circuits: it does not execute the second action if the first succeeds. But your one runs both actions unconditionally. For example, the expression try (return $ Just ()) (putStrLn "second action executed" >> return Nothing) outputs "second action executed" with your solution, but not with Evan's. The lesson is, applicative and monadic composition don't always yield the same results. Chris From ok at cs.otago.ac.nz Thu Nov 13 01:03:19 2014 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Thu, 13 Nov 2014 14:03:19 +1300 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141112073749.E1BAE93C43@mail.avvanta.com> References: <20141112073749.E1BAE93C43@mail.avvanta.com> Message-ID: On 12/11/2014, at 8:37 pm, Donn Cave wrote: > > It works to a certain extent with integral types, because I can > determine the size of the C field and assign an appropriate Haskell > foreign integral type. I used it to generate a module for struct termios, > for which I've been using hsc2hs, and it did better than hsc2hs in > an unexpected way - hsc2hs #type maps "unsigned long" to "Word32", > but on MacOS X the field size is 8 bytes. That?s not quite right. compile with ?cc -m64? and the field size is 8 bytes, but compile with ?cc -m32? and the field size is 4 bytes. (This actually strikes me as a flaw in Mac OS X: ?typedef unsigned long tcflag_t;? should have been ?typedef uint32_t tcflag_t;' because there?s no _reason_ for the field size to change this way.) The fact that the sizes of things can vary between compilation environments on the same host is one of the reasons tools like hsc2hs are hard. From creichert07 at gmail.com Thu Nov 13 01:07:28 2014 From: creichert07 at gmail.com (Christopher Reichert) Date: Wed, 12 Nov 2014 19:07:28 -0600 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <5463E2D3.7040305@power.com.pl> ("Wojtek =?utf-8?Q?Narczy?= =?utf-8?Q?=C5=84ski=22's?= message of "Wed, 12 Nov 2014 23:44:35 +0100") References: <5463E2D3.7040305@power.com.pl> Message-ID: <54640451.88f43c0a.7650.1457@mx.google.com> On Wed, Nov 12 2014, Wojtek Narczy?ski wrote: > Hello list, > > I have a question. > > How to create a DSL for HTML generation, that would (statically) allow > only valid HTML to be generated? Parent - child relations, valid > attributes only. > > Or does such a DSL already exist, perhaps? I'm not sure if it fits all your criteria but BlazeHtml might interest you. https://hackage.haskell.org/package/blaze-html Regards, -Christopher From cma at bitemyapp.com Thu Nov 13 01:22:58 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Wed, 12 Nov 2014 19:22:58 -0600 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> Message-ID: I'm working on a Haskell article for https://howistart.org/ which is actually about the rudiments of processing CSV data in Haskell. To that end, take a look at my rather messy workspace here: https://github.com/bitemyapp/csvtest And my in-progress article here: https://github.com/bitemyapp/howistart/blob/master/haskell/1/index.md (please don't post this anywhere, incomplete!) And here I'll link my notes on profiling memory use with different streaming abstractions: https://twitter.com/bitemyapp/status/531617919181258752 csv-conduit isn't in the test results because I couldn't figure out how to use it. pipes-csv is proper streaming, but uses cassava's parsing machinery and data types. Possibly this is a problem if you have really wide rows but I've never seen anything that would be problematic in that realm even when I did a lot of HDFS/Hadoop ecosystem stuff. AFAICT with pipes-csv you're streaming rows, but not columns. With csv-conduit you might be able to incrementally process the columns too based on my guess from glancing at the rather scary code. Let me know if you have any further questions. Cheers all. --- Chris Allen On Wed, Nov 12, 2014 at 4:17 PM, Markus L?ll wrote: > Hi Tobias, > > What he could do is encode the column values to appropriate lengths of > Word's to reduce the size -- to make it fit in ram. E.g listening times as > seconds, browsers as categorical variables (in statistics terms), etc. If > some of the columns are arbitrary length strings, then it seems possible to > get 12GB down by more than half. > > If he doesn't know Haskell, then I'd suggest using another language. > (Years ago I tried to do a bigger uni project in Haskell-- being a noob > --and failed miserably.) > On Nov 12, 2014 10:45 AM, "Tobias Pflug" wrote: > >> Hi, >> >> just the other day I talked to a friend of mine who works for an online >> radio service who told me he was currently looking into how best work with >> assorted usage data: currently 250 million entries as a 12GB in a csv >> comprising of information such as which channel was tuned in for how long >> with which user agent and what not. >> >> He accidentally ran into K and Q programming language (*1) which >> apparently work nicely for this as unfamiliar as it might seem. >> >> This certainly is not my area of expertise at all. I was just wondering >> how some of you would suggest to approach this with Haskell. How would you >> most efficiently parse such data evaluating custom queries ? >> >> Thanks for your time, >> Tobi >> >> [1] (http://en.wikipedia.org/wiki/K_(programming_language) >> [2] http://en.wikipedia.org/wiki/Q_(programming_language_from_Kx_Systems) >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From donn at avvanta.com Thu Nov 13 01:41:36 2014 From: donn at avvanta.com (Donn Cave) Date: Wed, 12 Nov 2014 17:41:36 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141113014136.F0F78276CB7@mail.avvanta.com> quoth Richard A. O'Keefe, ... > (This actually strikes me as a flaw in Mac OS X: > `typedef unsigned long tcflag_t;' should have been > `typedef uint32_t tcflag_t;' > because there's no _reason_ for the field size to change > this way.) True, it's crazy to have structures changing size like that when the effective size of each field is fixed per standard. > The fact that the sizes of things can vary between compilation > environments on the same host is one of the reasons tools like > hsc2hs are hard. I have to confess that this was to some degree my error as well - I was looking at a somewhat elderly hsc2hs output that probably predated the current architecture and platform level, and when I run it now, hsc2hs does assign the appropriate size foreign type and the right offsets. Donn From jeffbrown.the at gmail.com Thu Nov 13 02:00:56 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Wed, 12 Nov 2014 18:00:56 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: <87389o23wc.fsf@Shanna.FStaals.net> References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: What is the tradeoff here? Would polymorphic containers prohibit the compiler from the deep reasoning it can do without them? On Wed, Nov 12, 2014 at 12:56 AM, Frank Staals wrote: > Kannan Goundan writes: > > > Karl Voelker karlv.net> writes: > > > >> {-# LANGUAGE DataKinds #-} > >> {-# LANGUAGE GADTs #-} > >> {-# LANGUAGE KindSignatures #-} > >> module FS where > >> > >> type Date = String > >> > >> data FileKind = FILE | FOLDER > >> > >> data Entry (k :: FileKind) where > >> File :: String -> Date -> Int -> Entry FILE > >> Folder :: String -> String -> Entry FOLDER > > > > This is a little beyond my Haskell knowledge. What would the function > > signatures look like? Here are my guesses: > > > > listFolder :: Path -> [Entry ?] > > Unfortunately, we cannot have our cake and eat it as well. Entry FILE > and Entry FOLDER are now different types, and hence you cannot construct > a list containing both. In other words; we cannot really fill in the ? > in the type signature (or at least not that I'm aware of). Either we use > Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry > FOLDER)] or you have to create some existential type around an Entry > again, i.e. > > data SomeEntry where > SomeEntry :: Entry k -> SomeEntry > > listFolder :: Path -> [SomeEntry] > > You can get the file kind back by pattern matching again. > > > createFolder :: Path -> Entry FOLDER > > createFile :: Path -> Entry FOLDER > > the second one should produce something of type Entry FILE. > > > Also, lets say I wanted to just get the "id" fields from a list of > `Entry` > > values. Can someone help me fill in the blanks here? > > > > l :: [Entry ?] > > let ids = map (?) l > > This is basically the same issue as before. You cannot construct a list > that contains both Entry FILE and Entry FOLDER values. We can use type > classes together with the SomeEntry solution above though. > > ---- > > In general I like the fact that we can use the GADTs to obtain extra > type level guarantees. However, working with lists (or other data > structures) with them is a crime. I think for that, we need better > support for working with hetrogenious collections. > > -- > > - Frank > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Thu Nov 13 02:07:17 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Wed, 12 Nov 2014 21:07:17 -0500 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141113014136.F0F78276CB7@mail.avvanta.com> References: <20141113014136.F0F78276CB7@mail.avvanta.com> Message-ID: On Wed, Nov 12, 2014 at 8:41 PM, Donn Cave wrote: > quoth Richard A. O'Keefe, > ... > > (This actually strikes me as a flaw in Mac OS X: > > `typedef unsigned long tcflag_t;' should have been > > `typedef uint32_t tcflag_t;' > > because there's no _reason_ for the field size to change > > this way.) > > True, it's crazy to have structures changing size like that > when the effective size of each field is fixed per standard. > For what it's worth, this like many other things was inherited from FreeBSD. (See /usr/include/sys/_termios.h therein, which I chased down from /usr/include/termios.h.) -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Thu Nov 13 02:22:34 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 12 Nov 2014 21:22:34 -0500 Subject: [Haskell-cafe] data analysis question In-Reply-To: <87sihopkhq.fsf@write-only.cryp.to> References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> <87sihopkhq.fsf@write-only.cryp.to> Message-ID: <546415EA.30609@ro-che.info> On 12/11/14 09:21, Peter Simons wrote: > Hi Roman, > > > With Haskell you don't have to load the whole data set into memory, > > as Michael shows. With R, on the other hand, you do. > > Can you please point me to a reference to back that claim up? > > I'll offer [1] and [2] as a pretty good indications that you may not be > entirely right about this. Ah, great then. My impression was formed after listening to this FLOSS weekly episode: http://twit.tv/show/floss-weekly/306 (starting from 33:55). > > Besides, if you're not an R expert, and if the analysis you want to do > > is not readily available, it may be quite a pain to implement in R. > > Actually, implementing sophisticated queries in R is quite easy because > the language was specifically designed for that kind of thing. If you > have no experience in neither R nor Haskell, then learning R is *far* > easier than learning Haskell is because it doesn't aim to be a powerful > general-purpose programming language. It aims to be a powerful language > for data analysis. That doesn't match my experience. Maybe it's just me and my unwillingness and write C-like code that traverses arrays by indexes (I know most scientists don't have a problem with that), but I found it hard to express data transformations and queries functionally in R. > > I still don't know an acceptable way to write something like zipWith > > f (tail vec) vec in R. > > Why would that be any trouble? What kind of solutions did you find and > in what way were they unacceptable? This was a while ago, and I don't remember what solution I picked up eventually. Of course I could just write a for-loop to populate an array, but I hadn't found anything that matches the simplicity and clarity of the line above. How would you write it in R? Roman From jeffbrown.the at gmail.com Thu Nov 13 02:42:21 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Wed, 12 Nov 2014 18:42:21 -0800 Subject: [Haskell-cafe] data analysis question In-Reply-To: <546415EA.30609@ro-che.info> References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> <87sihopkhq.fsf@write-only.cryp.to> <546415EA.30609@ro-che.info> Message-ID: My experience with R is that, while worlds more powerful than the dominant commercial alternatives (Stata, SAS, it was unintuitive relative to other general-purpose languages like Python. I wonder/speculate whether it was distorted by the pull of its statistical applications away from what would be more natural. On Wed, Nov 12, 2014 at 6:22 PM, Roman Cheplyaka wrote: > On 12/11/14 09:21, Peter Simons wrote: > > Hi Roman, > > > > > With Haskell you don't have to load the whole data set into memory, > > > as Michael shows. With R, on the other hand, you do. > > > > Can you please point me to a reference to back that claim up? > > > > I'll offer [1] and [2] as a pretty good indications that you may not be > > entirely right about this. > > Ah, great then. > > My impression was formed after listening to this FLOSS weekly episode: > http://twit.tv/show/floss-weekly/306 (starting from 33:55). > > > > Besides, if you're not an R expert, and if the analysis you want to do > > > is not readily available, it may be quite a pain to implement in R. > > > > Actually, implementing sophisticated queries in R is quite easy because > > the language was specifically designed for that kind of thing. If you > > have no experience in neither R nor Haskell, then learning R is *far* > > easier than learning Haskell is because it doesn't aim to be a powerful > > general-purpose programming language. It aims to be a powerful language > > for data analysis. > > That doesn't match my experience. Maybe it's just me and my > unwillingness and write C-like code that traverses arrays by indexes (I > know most scientists don't have a problem with that), but I found it > hard to express data transformations and queries functionally in R. > > > > I still don't know an acceptable way to write something like zipWith > > > f (tail vec) vec in R. > > > > Why would that be any trouble? What kind of solutions did you find and > > in what way were they unacceptable? > > This was a while ago, and I don't remember what solution I picked up > eventually. Of course I could just write a for-loop to populate an > array, but I hadn't found anything that matches the simplicity and > clarity of the line above. How would you write it in R? > > Roman > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Thu Nov 13 02:52:30 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Wed, 12 Nov 2014 21:52:30 -0500 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> <87sihopkhq.fsf@write-only.cryp.to> <546415EA.30609@ro-che.info> Message-ID: On Wed, Nov 12, 2014 at 9:42 PM, Jeffrey Brown wrote: > My experience with R is that, while worlds more powerful than the dominant > commercial alternatives (Stata, SAS, it was unintuitive relative to other > general-purpose languages like Python. I wonder/speculate whether it was > distorted by the pull of its statistical applications away from what would > be more natural. > It is an open source implementation of S ( http://en.wikipedia.org/wiki/S_(programming_language) ) which was developed specifically for statistical applications. I would wonder how much of *that* was shaped by Fortran statistical packages.... -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From jmartin at eecs.berkeley.edu Thu Nov 13 03:43:22 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Wed, 12 Nov 2014 19:43:22 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: The tradeoff for using existentials: - You need to have an explicit covariance rule. It is necessary to call MkFsEntry (or in Frank's case: SomeEntry). - It is impossible to prove the contravariant case. If you give me a FsEntry, how do I convert it back to a FsFile or a FsFolder? For Frank's case, I can't create either of these functions and guarantee anything statically. convertBack :: SomeEntry -> FsEntry k or convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) Or my case: convertBack :: (IsFsEntry a) => FsEntry -> a or convertBack :: FsEntry -> Either FsFile FsFolder The reason is rather simple. What if someone were to introduce a third thing that is a FsEntry, and we didn't cover that case? It is impossible to cover all possible cases because someone could come around and just add another one. We could introduce a runtime check in a similar way to how the read function works. However, we can make no static guarantee. James On Wed, Nov 12, 2014 at 6:00 PM, Jeffrey Brown wrote: > What is the tradeoff here? Would polymorphic containers prohibit the > compiler from the deep reasoning it can do without them? > > On Wed, Nov 12, 2014 at 12:56 AM, Frank Staals wrote: > >> Kannan Goundan writes: >> >> > Karl Voelker karlv.net> writes: >> > >> >> {-# LANGUAGE DataKinds #-} >> >> {-# LANGUAGE GADTs #-} >> >> {-# LANGUAGE KindSignatures #-} >> >> module FS where >> >> >> >> type Date = String >> >> >> >> data FileKind = FILE | FOLDER >> >> >> >> data Entry (k :: FileKind) where >> >> File :: String -> Date -> Int -> Entry FILE >> >> Folder :: String -> String -> Entry FOLDER >> > >> > This is a little beyond my Haskell knowledge. What would the function >> > signatures look like? Here are my guesses: >> > >> > listFolder :: Path -> [Entry ?] >> >> Unfortunately, we cannot have our cake and eat it as well. Entry FILE >> and Entry FOLDER are now different types, and hence you cannot construct >> a list containing both. In other words; we cannot really fill in the ? >> in the type signature (or at least not that I'm aware of). Either we use >> Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry >> FOLDER)] or you have to create some existential type around an Entry >> again, i.e. >> >> data SomeEntry where >> SomeEntry :: Entry k -> SomeEntry >> >> listFolder :: Path -> [SomeEntry] >> >> You can get the file kind back by pattern matching again. >> >> > createFolder :: Path -> Entry FOLDER >> > createFile :: Path -> Entry FOLDER >> >> the second one should produce something of type Entry FILE. >> >> > Also, lets say I wanted to just get the "id" fields from a list of >> `Entry` >> > values. Can someone help me fill in the blanks here? >> > >> > l :: [Entry ?] >> > let ids = map (?) l >> >> This is basically the same issue as before. You cannot construct a list >> that contains both Entry FILE and Entry FOLDER values. We can use type >> classes together with the SomeEntry solution above though. >> >> ---- >> >> In general I like the fact that we can use the GADTs to obtain extra >> type level guarantees. However, working with lists (or other data >> structures) with them is a crime. I think for that, we need better >> support for working with hetrogenious collections. >> >> -- >> >> - Frank >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Thu Nov 13 05:00:53 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Wed, 12 Nov 2014 21:00:53 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141112073749.E1BAE93C43@mail.avvanta.com> References: <20141112073749.E1BAE93C43@mail.avvanta.com> Message-ID: Doesn't hsc2hs give you the size with #size? I feel like I'm not understanding your approach. I was thinking of using language-c to parse the .h file, and generate an hs file: structs.h: struct example { int a; char b; } Structs_generated.hs: module X.Y.Structs_generated where import X.Y.Structs (Example) poke_example_a :: (#type int) -> Ptr Example -> IO () poke_example_b :: (#type char) -> Ptr Example -> IO () example_alignment = 4 example_size = 5 You have to provide the Structs module that exports the types, this just makes sure that the pokes only work on the intended types. Then the poke functions tie the struct field name and its type and the record type. For the #type I could either then run this through hsc2hs to get the types, or just have a hardcoded mapping. #type sees through typedefs and the like, but all it can see is size and signedness. While I'm at it I could add foreign declarations for the function prototypes, and solve the problem of keeping those in sync. Another thing I like about this approach is that you import a generated file, but all the marshaling work is done in a plain .hs file. Putting code in a .hsc breaks ghci since you need to regenerate after each edit, and it breaks tools that want to parse hs source. I'm sure it's way more complicated than it seems though, things inevitably are. I read the c2hs docs but I kind of don't really get it yet. I should just download a project that uses it and see how it works. On Wed, Nov 12, 2014 at 5:03 PM, Richard A. O'Keefe wrote: > The fact that the sizes of things can vary between compilation > environments on the same host is one of the reasons tools like > hsc2hs are hard. That just means you need the same compiler flags for the C side as for the haskell side, right? Presumably that's not too hard because you build it all together. Or is there some further complexity? From dominic at steinitz.org Thu Nov 13 05:44:22 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Thu, 13 Nov 2014 05:44:22 +0000 (UTC) Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> Message-ID: Tobias Pflug gmx.net> writes: > > Hi, > > just the other day I talked to a friend of mine who works for an online > radio service who told me he was currently looking into how best work > with assorted usage data: currently 250 million entries as a 12GB in a > csv comprising of information such as which channel was tuned in for how > long with which user agent and what not. > > He accidentally ran into K and Q programming language (*1) which > apparently work nicely for this as unfamiliar as it might seem. > > This certainly is not my area of expertise at all. I was just wondering > how some of you would suggest to approach this with Haskell. How would > you most efficiently parse such data evaluating custom queries ? > > Thanks for your time, > Tobi > > [1] (http://en.wikipedia.org/wiki/K_(programming_language) > [2] http://en.wikipedia.org/wiki/Q_(programming_language_from_Kx_Systems) > Hi Tobias, I use Haskell and R (and Matlab) at work. You can certainly do data analysis in Haskell; here is a fairly long example http://idontgetoutmuch.wordpress.com/2013/10/23/parking-in-westminster-an-analysis-in- haskell/. IIRC the dataset was about 2G so not dissimilar to the one you are thinking of analysing. I didn't seem to need pipes or conduits but just used cassava. The data were plotted on a map of London (yes you can draw maps in Haskell) with diagrams and shapefile (http://hackage.haskell.org/package/shapefile). But R (and pandas in python) make this sort of analysis easier. As a small example, my data contained numbers like -.1.2 and dates and times. R will happily parse these but in Haskell you have to roll your own (not that this is difficult and "someone" ought to write a library like pandas so that the wheel is not continually re-invented). Also R (and python) have extensive data analysis libraries so if e.g. you want to apply Nelder Mead then a very well documented R package exists; I searched in vain for this in Haskell. Similarly, if you want to construct a GARCH model, then there is not only a package but an active community upon whom you can call for help. I have the benefit of being able to use this at work http://ifl2014.github.io/submissions/ifl2014_submission_16.pdf and I am hoping that it will be open-sourced "real soon now" but it will probably not be available in time for your analysis. I should also add that my workflow (for data analysis) in Haskell is similar to that in R. I do a small amount of analysis either in a file or at the command line and usually chart the results again using the command line: http://hackage.haskell.org/package/Chart I haven't had time to try iHaskell but I think the next time I have some data analysis to do I will try it out. http://gibiansky.github.io/IHaskell/demo.html http://andrew.gibiansky.com/blog/haskell/finger-trees/ Finally, doing data analysis is quite different from quality production code. I would imagine turning Haskell data analysis into production code would be a lot easier than doing this in R. Dominic. From ok at cs.otago.ac.nz Thu Nov 13 05:44:54 2014 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Thu, 13 Nov 2014 18:44:54 +1300 Subject: [Haskell-cafe] data analysis question In-Reply-To: <87sihopkhq.fsf@write-only.cryp.to> References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> <87sihopkhq.fsf@write-only.cryp.to> Message-ID: On 13/11/2014, at 3:21 am, Peter Simons wrote: > Hi Roman, > >> With Haskell you don't have to load the whole data set into memory, >> as Michael shows. With R, on the other hand, you do. > > Can you please point me to a reference to back that claim up? > > I'll offer [1] and [2] as a pretty good indications that you may not be > entirely right about this. It is *possible* to handle large data sets with R, but it is *usual* to deal with things in memory. > >> Besides, if you're not an R expert, and if the analysis you want to do >> is not readily available, it may be quite a pain to implement in R. A heck of a lot of code in R has been developed by people who think of themselves as statisticians/financial analysts/whatever rather than programmers or ?R experts?. There is much to dislike about R (C-like syntax, the ?interactive if? trap, the clash of naming styles) but it has to be said that R is a very good for for the data analysis problems S was designed for, and I personally would find it *far* easier to develop such a solution in R than Haskell. (For other problems, of course, it would be the other way around.) Not only does R already have a stupefying number of packages offering all sorts of analyses, so that it?s quite hard to find something that you *have* to implement, there is an extremely active mailing list with searchable archives and full of wizards keen to help. If you *did* have to implement something, you wouldn?t be on your own. The specific case of ?zipwith f (tail vec) vec? is easy: (1) vec[-1] is vec without its first element vec[-length(vec)] is vec without its last element (2) cbind(vec[-1], vec[-length(vec)]) is an array with 2 columns. (3) apply(cbind(vec[-1], vec[-length(vec)]), 1, f) applies f to the rows of that matrix. If f returns one number, the answer is a vector; if f returns a row, the answer is a matrix. Example: > vec <- c(1,2,3,4,5) > mat <- cbind(vec[-1], vec[-length(vec)]) > apply(mat, 1, sum) [1] 3 5 7 9 In this case, you could just do > vec[-1] + vec[-length(vec)] and get the same answer. Oddly enough, one of the tricks for success in R is, like Haskell, to learn your way around the higher-order functions in the library. From ok at cs.otago.ac.nz Thu Nov 13 06:05:00 2014 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Thu, 13 Nov 2014 19:05:00 +1300 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <87tx24hg7z.fsf@write-only.cryp.to> <54634B06.2070809@ro-che.info> <87sihopkhq.fsf@write-only.cryp.to> <546415EA.30609@ro-che.info> Message-ID: On 13/11/2014, at 3:52 pm, Brandon Allbery wrote: > > It is an open source implementation of S ( http://en.wikipedia.org/wiki/S_(programming_language) ) which was developed specifically for statistical applications. I would wonder how much of *that* was shaped by Fortran statistical packages?. The prehistoric version of S *was* a Fortran statistical package. While the inventors of S were familiar with GLIM, GENSTAT, SPSS, SAS, BMDP, MINITAB, &c. they _were_ at Bell Labs, and so the language looks a lot like C. Indeed, several aspects of S were shaped by UNIX, in particular the way S (but not R) treats the current directory as an ?outer block?. Many (even new) R packages are wrappers around Fortran code. However, that has had almost no influence on the language itself. In particular: - arrays are immutable > (v <- 1:5) > w <- v > w[3] <- 33 > w [1] 1 2 33 4 5 > v [1] 1 2 3 4 5 - functions are first class values and higher order functions are commonplace - function arguments are evaluated lazily - good style does *NOT* ?traverse arrays by indexes? but operates on whole arrays in APL/Fortran 90 style. For example, you do not do for (i in 1:m) for (j in 1:n) r[i,j] <- f(v[i], w[j]) but r <- outer(v, w, f) If you _do_ ?express data transformations and queries functionally in R? ? which I repeat is native good style ? it will perform well; if you ?traverse arrays by indexes? you will wish you hadn?t. This is not something that Fortran 66 or Fortran 77 would have taught anyone. Let me put it this way: R is about as close to a functional language as you can get without actually being one. (The implementors of R consciously adopted implementation techniques from Scheme.) From donn at avvanta.com Thu Nov 13 06:23:40 2014 From: donn at avvanta.com (Donn Cave) Date: Wed, 12 Nov 2014 22:23:40 -0800 (PST) Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: References: Message-ID: <20141113062340.77BAA93C2E@mail.avvanta.com> quoth Evan Laforge > Doesn't hsc2hs give you the size with #size? I feel like I'm not > understanding your approach. Maybe it does, and I only need a clue to the syntax. I have seen it used only for the size of the struct; I'm looking for the size of a field - and devoid of parentheses or other adornments, so I can tack it onto something like Word or Int. You could define type aliases for other variable-size foreign types, like Float8 etc. and use #fieldsize to select them. One of your objections was that you're obliged to code field types in the .hsc file, and if you make an error or the types are changed later in the C code, hsc2hs doesn't notice. This approach gives you a way to partially derive a foreign type from the size of the field. I don't know language-c. Lots of interesting potential there if it works well. Donn From creichert07 at gmail.com Thu Nov 13 06:26:46 2014 From: creichert07 at gmail.com (Christopher Reichert) Date: Thu, 13 Nov 2014 00:26:46 -0600 Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> Message-ID: <54644f26.82acca0a.b327.ffff8093@mx.google.com> On Wed, Nov 12 2014, Christopher Allen wrote: > [Snip] > csv-conduit isn't in the test results because I couldn't figure out how to > use it. pipes-csv is proper streaming, but uses cassava's parsing machinery > and data types. Possibly this is a problem if you have really wide rows but > I've never seen anything that would be problematic in that realm even when > I did a lot of HDFS/Hadoop ecosystem stuff. AFAICT with pipes-csv you're > streaming rows, but not columns. With csv-conduit you might be able to > incrementally process the columns too based on my guess from glancing at > the rather scary code. > Any problems in particular? I've had pretty good luck with csv-conduit. However, I have noticed that it's rather picky about type signatures and integrating custom data types isn't straight forward at first. csv-conduit also seems to have drawn inspiration from cassava: http://hackage.haskell.org/package/csv-conduit-0.6.3/docs/Data-CSV-Conduit-Conversion.html > [Snip] > To that end, take a look at my rather messy workspace here: > https://github.com/bitemyapp/csvtest I've made a PR for the conduit version: https://github.com/bitemyapp/csvtest/pull/1 It could certainly be made more performent but it seems to hold up well in comparison. I would be interested in reading the How I Start Article and hearing more about your conclusions. Is this focused primarily on the memory profile or also speed? Regards, -Christopher > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From cma at bitemyapp.com Thu Nov 13 06:32:22 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Thu, 13 Nov 2014 00:32:22 -0600 Subject: [Haskell-cafe] data analysis question In-Reply-To: <54644f26.82acca0a.b327.ffff8093@mx.google.com> References: <54632C2B.6000803@gmx.net> <54644f26.82acca0a.b327.ffff8093@mx.google.com> Message-ID: Memory profiling only to test how stream-y the streaming was. I didn't think perf would be that different between them. The way I had to transform my fold for Pipes was a titch awkward, otherwise happy with it. If people are that interested in the perf side of things I can setup a criterion harness and publish those numbers as well. Mostly I was impressed with: 1. How easy it was to start using the streaming module in Cassava because it's just a Foldable instance. 2. How Pipes used <600kb of memory. Your pull request for csv-conduit looks really clean and nice. I've merged it, thanks for sending it my way! --- Chris Allen On Thu, Nov 13, 2014 at 12:26 AM, Christopher Reichert < creichert07 at gmail.com> wrote: > > On Wed, Nov 12 2014, Christopher Allen wrote: > > [Snip] > > csv-conduit isn't in the test results because I couldn't figure out how > to > > use it. pipes-csv is proper streaming, but uses cassava's parsing > machinery > > and data types. Possibly this is a problem if you have really wide rows > but > > I've never seen anything that would be problematic in that realm even > when > > I did a lot of HDFS/Hadoop ecosystem stuff. AFAICT with pipes-csv you're > > streaming rows, but not columns. With csv-conduit you might be able to > > incrementally process the columns too based on my guess from glancing at > > the rather scary code. > > > > Any problems in particular? I've had pretty good luck with > csv-conduit. However, I have noticed that it's rather picky about type > signatures and integrating custom data types isn't straight forward at > first. > > csv-conduit also seems to have drawn inspiration from cassava: > > http://hackage.haskell.org/package/csv-conduit-0.6.3/docs/Data-CSV-Conduit-Conversion.html > > > [Snip] > > To that end, take a look at my rather messy workspace here: > > https://github.com/bitemyapp/csvtest > > I've made a PR for the conduit version: > https://github.com/bitemyapp/csvtest/pull/1 > > > It could certainly be made more performent but it seems to hold up well > in comparison. I would be interested in reading the How I Start Article > and hearing more about your conclusions. Is this focused primarily on > the memory profile or also speed? > > > Regards, > -Christopher > > > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jmartin at eecs.berkeley.edu Thu Nov 13 07:10:14 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Wed, 12 Nov 2014 23:10:14 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: I didn't explain Frank's case, only the one I constructed. convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) For this function to work, we would need some way to inspect the type as a value, and this can only generally be done with dependent types. convertBack :: SomeEntry -> FsEntry k This case is technically possible to do statically, but not very useful because we have no idea what the actual type is. Therefore, we could only use it on things that work for all FsEntry and not just a subset. We could ask for what 'k' is in the type system and perform the necessary computation in the type system. However, this is complicated, and Haskell currently only has very limited support for moving between values and types. You can look at GHC.TypeLits for an example of this. James On Wed, Nov 12, 2014 at 7:43 PM, James M wrote: > The tradeoff for using existentials: > - You need to have an explicit covariance rule. It is necessary to call > MkFsEntry (or in Frank's case: SomeEntry). > - It is impossible to prove the contravariant case. > If you give me a FsEntry, how do I convert it back to a FsFile or a > FsFolder? > > For Frank's case, I can't create either of these functions and guarantee > anything statically. > > convertBack :: SomeEntry -> FsEntry k > > or > > convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) > > Or my case: > > convertBack :: (IsFsEntry a) => FsEntry -> a > > or > > convertBack :: FsEntry -> Either FsFile FsFolder > > The reason is rather simple. What if someone were to introduce a third > thing that is a FsEntry, and we didn't cover that case? It is impossible to > cover all possible cases because someone could come around and just add > another one. > > We could introduce a runtime check in a similar way to how the read > function works. However, we can make no static guarantee. > > James > > On Wed, Nov 12, 2014 at 6:00 PM, Jeffrey Brown > wrote: > >> What is the tradeoff here? Would polymorphic containers prohibit the >> compiler from the deep reasoning it can do without them? >> >> On Wed, Nov 12, 2014 at 12:56 AM, Frank Staals wrote: >> >>> Kannan Goundan writes: >>> >>> > Karl Voelker karlv.net> writes: >>> > >>> >> {-# LANGUAGE DataKinds #-} >>> >> {-# LANGUAGE GADTs #-} >>> >> {-# LANGUAGE KindSignatures #-} >>> >> module FS where >>> >> >>> >> type Date = String >>> >> >>> >> data FileKind = FILE | FOLDER >>> >> >>> >> data Entry (k :: FileKind) where >>> >> File :: String -> Date -> Int -> Entry FILE >>> >> Folder :: String -> String -> Entry FOLDER >>> > >>> > This is a little beyond my Haskell knowledge. What would the function >>> > signatures look like? Here are my guesses: >>> > >>> > listFolder :: Path -> [Entry ?] >>> >>> Unfortunately, we cannot have our cake and eat it as well. Entry FILE >>> and Entry FOLDER are now different types, and hence you cannot construct >>> a list containing both. In other words; we cannot really fill in the ? >>> in the type signature (or at least not that I'm aware of). Either we use >>> Either (pun intended): listFolder :: Path -> [Either (Entry FILE) (Entry >>> FOLDER)] or you have to create some existential type around an Entry >>> again, i.e. >>> >>> data SomeEntry where >>> SomeEntry :: Entry k -> SomeEntry >>> >>> listFolder :: Path -> [SomeEntry] >>> >>> You can get the file kind back by pattern matching again. >>> >>> > createFolder :: Path -> Entry FOLDER >>> > createFile :: Path -> Entry FOLDER >>> >>> the second one should produce something of type Entry FILE. >>> >>> > Also, lets say I wanted to just get the "id" fields from a list of >>> `Entry` >>> > values. Can someone help me fill in the blanks here? >>> > >>> > l :: [Entry ?] >>> > let ids = map (?) l >>> >>> This is basically the same issue as before. You cannot construct a list >>> that contains both Entry FILE and Entry FOLDER values. We can use type >>> classes together with the SomeEntry solution above though. >>> >>> ---- >>> >>> In general I like the fact that we can use the GADTs to obtain extra >>> type level guarantees. However, working with lists (or other data >>> structures) with them is a crime. I think for that, we need better >>> support for working with hetrogenious collections. >>> >>> -- >>> >>> - Frank >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From lambda.fairy at gmail.com Thu Nov 13 07:17:54 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Thu, 13 Nov 2014 20:17:54 +1300 Subject: [Haskell-cafe] open-source project looking for novice help? In-Reply-To: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> References: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> Message-ID: Hi Richard, On Sat, Nov 8, 2014 at 7:40 AM, Richard Eisenberg wrote: > I'm teaching an introductory Haskell course this semester > (http://cis.upenn.edu/~cis194/fall14/) and am about to assign students their > final project. Is there anyone out there who would welcome getting some > novice help on an open-source project? You certainly don't need to commit to > accept their patch(es), but I know it would be a great experience for some > of the students to contribute to the "real" world of Haskell, instead of > just doing exercises. You can get an accurate summary of what we've covered > by looking at the lecture titles at > http://cis.upenn.edu/~cis194/fall14/lectures.html > > Students will be choosing projects starting next week, and will need to have > them completed by Dec. 15 or so. A good project is about 20 hours of work. Hope I'm not too late to chime in! I maintain a GUI testing package called Robot [1]. It's a simple library with clear semantics which seems quite suitable for your students. Some project ideas, from easiest to hardest: * Taking screenshots. XHB exposes a GetImage call [2]; it shouldn't be too much work integrating that into the library. * Adding a configurable delay between operations. This involves some work with monads (ReaderT specifically). * Windows and Mac support. Some good practice with Cabal and the FFI here. * xdotool [3] does a few things, like searching for windows by title, that I'd like to see in Robot. Porting some of these features over sounds like a good (albeit open-ended) project. Hope this helps. Chris [1] http://hackage.haskell.org/package/robot [2] http://hackage.haskell.org/package/xhb-0.5.2014.4.10/docs/Graphics-XHB-Gen-Xproto.html#v:getImage [3] http://www.semicomplete.com/projects/xdotool/ From michael at snoyman.com Thu Nov 13 07:29:02 2014 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 13 Nov 2014 07:29:02 +0000 Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> <54644f26.82acca0a.b327.ffff8093@mx.google.com> Message-ID: Somewhat off topic, but: I said csv-conduit because I have some experience with it. When we were doing some analytic work at FP Complete, a few of us analyzed both csv-conduit and cassava, and didn't really have a good feel for which was the better library. We went with csv-conduit[1], but I'd be really interested in hearing a comparison of the two libraries from someone who knows about them. [1] Don't ask what tipped us in that direction, I honestly don't remember what it was. On Thu Nov 13 2014 at 9:24:47 AM Christopher Allen wrote: > Memory profiling only to test how stream-y the streaming was. I didn't > think perf would be that different between them. The way I had to transform > my fold for Pipes was a titch awkward, otherwise happy with it. > > If people are that interested in the perf side of things I can setup a > criterion harness and publish those numbers as well. > > Mostly I was impressed with: > > 1. How easy it was to start using the streaming module in Cassava because > it's just a Foldable instance. > > 2. How Pipes used <600kb of memory. > > Your pull request for csv-conduit looks really clean and nice. I've merged > it, thanks for sending it my way! > > --- Chris Allen > > > On Thu, Nov 13, 2014 at 12:26 AM, Christopher Reichert < > creichert07 at gmail.com> wrote: > >> >> On Wed, Nov 12 2014, Christopher Allen wrote: >> > [Snip] >> > csv-conduit isn't in the test results because I couldn't figure out how >> to >> > use it. pipes-csv is proper streaming, but uses cassava's parsing >> machinery >> > and data types. Possibly this is a problem if you have really wide rows >> but >> > I've never seen anything that would be problematic in that realm even >> when >> > I did a lot of HDFS/Hadoop ecosystem stuff. AFAICT with pipes-csv you're >> > streaming rows, but not columns. With csv-conduit you might be able to >> > incrementally process the columns too based on my guess from glancing at >> > the rather scary code. >> > >> >> Any problems in particular? I've had pretty good luck with >> csv-conduit. However, I have noticed that it's rather picky about type >> signatures and integrating custom data types isn't straight forward at >> first. >> >> csv-conduit also seems to have drawn inspiration from cassava: >> >> http://hackage.haskell.org/package/csv-conduit-0.6.3/docs/Data-CSV-Conduit-Conversion.html >> >> > [Snip] >> > To that end, take a look at my rather messy workspace here: >> > https://github.com/bitemyapp/csvtest >> >> I've made a PR for the conduit version: >> https://github.com/bitemyapp/csvtest/pull/1 >> >> >> It could certainly be made more performent but it seems to hold up well >> in comparison. I would be interested in reading the How I Start Article >> and hearing more about your conclusions. Is this focused primarily on >> the memory profile or also speed? >> >> >> Regards, >> -Christopher >> >> >> > Haskell-Cafe mailing list >> > Haskell-Cafe at haskell.org >> > http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Thu Nov 13 07:29:50 2014 From: spam at scientician.net (Bardur Arantsson) Date: Thu, 13 Nov 2014 08:29:50 +0100 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: On 2014-11-13 08:10, James M wrote: > I didn't explain Frank's case, only the one I constructed. > > convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) > > For this function to work, we would need some way to inspect the type as a > value, and this can only generally be done with dependent types. > > convertBack :: SomeEntry -> FsEntry k > > This case is technically possible to do statically, but not very useful > because we have no idea what the actual type is. Therefore, we could only > use it on things that work for all FsEntry and not just a subset. > > We could ask for what 'k' is in the type system and perform the necessary > computation in the type system. However, this is complicated, and Haskell > currently only has very limited support for moving between values and > types. You can look at GHC.TypeLits for an example of this. Maybe I'm missing something, but wouldn't adding a Typeable constraint on the existential give you the option of casting back? AFAICT that should be sufficient since the FileKind is closed and you can thus just attempt both conversions and see which one succeeds. Regards, From alfredo.dinapoli at gmail.com Thu Nov 13 07:34:35 2014 From: alfredo.dinapoli at gmail.com (Alfredo Di Napoli) Date: Thu, 13 Nov 2014 08:34:35 +0100 Subject: [Haskell-cafe] How is maintaining the iCalendar package? Message-ID: Hello fellow Haskellers, anybody knows who is maintaining https://github.com/tingtun/iCalendar ? I have tried to email the maintainer listed on Github, but his activity seems quite low. Posting it here hoping to get a bit more resonance. Alfredo -------------- next part -------------- An HTML attachment was scrubbed... URL: From jmartin at eecs.berkeley.edu Thu Nov 13 07:47:02 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Wed, 12 Nov 2014 23:47:02 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: This is easily testable. deriving instance Typeable Entry deriving instance Typeable FileKind deriving instance Typeable 'FOLDER deriving instance Typeable 'FILE convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) convertBack (SomeEntry x) | typeOf x == typeOf (Folder "" "") = Right x | otherwise = Left x The error I get is this: Couldn't match type 'k' with ''FOLDER' 'k' is a rigid type variable bound by a pattern with constructor SomeEntry :: forall (k :: FileKind). Entry k -> SomeEntry, in an equation for 'convertBack' at cafe2.hs:24:14 Expected type: Entry 'FOLDER Actual type: Entry k Relevant bindings include x :: Entry k (bound at cafe2.hs:24:24) In the first argument of 'Right', namely 'x' In the expression: Right x James On Wed, Nov 12, 2014 at 11:29 PM, Bardur Arantsson wrote: > On 2014-11-13 08:10, James M wrote: > > I didn't explain Frank's case, only the one I constructed. > > > > convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) > > > > For this function to work, we would need some way to inspect the type as > a > > value, and this can only generally be done with dependent types. > > > > convertBack :: SomeEntry -> FsEntry k > > > > This case is technically possible to do statically, but not very useful > > because we have no idea what the actual type is. Therefore, we could only > > use it on things that work for all FsEntry and not just a subset. > > > > We could ask for what 'k' is in the type system and perform the necessary > > computation in the type system. However, this is complicated, and Haskell > > currently only has very limited support for moving between values and > > types. You can look at GHC.TypeLits for an example of this. > > Maybe I'm missing something, but wouldn't adding a Typeable constraint > on the existential give you the option of casting back? AFAICT that > should be sufficient since the FileKind is closed and you can thus just > attempt both conversions and see which one succeeds. > > Regards, > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jmartin at eecs.berkeley.edu Thu Nov 13 07:57:39 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Wed, 12 Nov 2014 23:57:39 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: To explain, you should think of forall (k :: FileKind) . Entry k as being different than Entry 'FOLDER Entry 'FILE The difference being that anything that is 'k' must be able to satisfy all FileKind not just one of them. James On Wed, Nov 12, 2014 at 11:47 PM, James M wrote: > This is easily testable. > > deriving instance Typeable Entry > deriving instance Typeable FileKind > deriving instance Typeable 'FOLDER > deriving instance Typeable 'FILE > > convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) > convertBack (SomeEntry x) > | typeOf x == typeOf (Folder "" "") = Right x > | otherwise = Left x > > The error I get is this: > > Couldn't match type 'k' with ''FOLDER' > 'k' is a rigid type variable bound by > a pattern with constructor > SomeEntry :: forall (k :: FileKind). Entry k -> SomeEntry, > in an equation for 'convertBack' > at cafe2.hs:24:14 > Expected type: Entry 'FOLDER > Actual type: Entry k > Relevant bindings include x :: Entry k (bound at cafe2.hs:24:24) > In the first argument of 'Right', namely 'x' > In the expression: Right x > > James > > > On Wed, Nov 12, 2014 at 11:29 PM, Bardur Arantsson > wrote: > >> On 2014-11-13 08:10, James M wrote: >> > I didn't explain Frank's case, only the one I constructed. >> > >> > convertBack :: SomeEntry -> Either (FsEntry FILE) (FsEntry FOLDER) >> > >> > For this function to work, we would need some way to inspect the type >> as a >> > value, and this can only generally be done with dependent types. >> > >> > convertBack :: SomeEntry -> FsEntry k >> > >> > This case is technically possible to do statically, but not very useful >> > because we have no idea what the actual type is. Therefore, we could >> only >> > use it on things that work for all FsEntry and not just a subset. >> > >> > We could ask for what 'k' is in the type system and perform the >> necessary >> > computation in the type system. However, this is complicated, and >> Haskell >> > currently only has very limited support for moving between values and >> > types. You can look at GHC.TypeLits for an example of this. >> >> Maybe I'm missing something, but wouldn't adding a Typeable constraint >> on the existential give you the option of casting back? AFAICT that >> should be sufficient since the FileKind is closed and you can thus just >> attempt both conversions and see which one succeeds. >> >> Regards, >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Thu Nov 13 08:18:50 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Thu, 13 Nov 2014 09:18:50 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <54640451.88f43c0a.7650.1457@mx.google.com> References: <5463E2D3.7040305@power.com.pl> <54640451.88f43c0a.7650.1457@mx.google.com> Message-ID: <5464696A.7060808@power.com.pl> On 13.11.2014 02:07, Christopher Reichert wrote: > > I'm not sure if it fits all your criteria but BlazeHtml might interest you. > > https://hackage.haskell.org/package/blaze-html > AFAIR, the objective of blaze is speed, rather than correctness of result, so you can do this, for example. example :: Html example = do H.title $ do H.html "rather" H.body "strange" H.head $ do H.h1 "document" Blaze would be great as a high performance "assembler" for such a DSL. My question is how to capture (at least some of) the HTML validity rules in Haskell types, or classes, or families, or whatever. -- Regards, Wojtek From ollie at ocharles.org.uk Thu Nov 13 11:33:20 2014 From: ollie at ocharles.org.uk (Oliver Charles) Date: Thu, 13 Nov 2014 11:33:20 +0000 Subject: [Haskell-cafe] How is maintaining the iCalendar package? In-Reply-To: References: Message-ID: <87k32z49of.fsf@fynder-widget.localhost> Alfredo Di Napoli writes: > Hello fellow Haskellers, > > anybody knows who is maintaining > > https://github.com/tingtun/iCalendar > > ? > > I have tried to email the maintainer listed on Github, but his activity > seems quite low. > Posting it here hoping to get a bit more resonance. I sent some patches a few months ago and got them merged promptly - maybe give it a bit longer? - ocharles From idhameed at gmail.com Thu Nov 13 08:40:49 2014 From: idhameed at gmail.com (Imran Hameed) Date: Thu, 13 Nov 2014 00:40:49 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: References: Message-ID: On Mon, Nov 10, 2014 at 5:44 PM, Kannan Goundan wrote: > (I'm assuming some way of specifying that FsEntry will only ever have those > two subtypes.) > > How would you represent this in Haskell? data FsEntry a = FsEntry { id :: String, info :: a } data FileInfo = FileInfo { modified :: Double, size :: Int } data FolderInfo = FolderInfo { owner :: String } data FsListEntry = File (FsEntry FileInfo) | Folder (FsEntry FolderInfo) type Path = String listFolder :: Path -> [FsListEntry] createFile :: Path -> FsEntry FileInfo createFolder :: Path -> FsEntry FolderInfo functionThatExpectsAnyFsEntry :: FsEntry a -> () From mwm at mired.org Thu Nov 13 08:56:31 2014 From: mwm at mired.org (Mike Meyer) Date: Thu, 13 Nov 2014 02:56:31 -0600 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <5464696A.7060808@power.com.pl> References: <5463E2D3.7040305@power.com.pl> <54640451.88f43c0a.7650.1457@mx.google.com> <5464696A.7060808@power.com.pl> Message-ID: On Thu, Nov 13, 2014 at 2:18 AM, Wojtek Narczy?ski wrote: > > On 13.11.2014 02:07, Christopher Reichert wrote: > >> >> I'm not sure if it fits all your criteria but BlazeHtml might interest >> you. >> >> https://hackage.haskell.org/package/blaze-html >> >> > AFAIR, the objective of blaze is speed, rather than correctness of result, > so you can do this, for example. > > example :: Html > example = do > H.title $ do > H.html "rather" > H.body "strange" > H.head $ do > H.h1 "document" > > Blaze would be great as a high performance "assembler" for such a DSL. > > My question is how to capture (at least some of) the HTML validity rules > in Haskell types, or classes, or families, or whatever. > That's pretty much it - or at least how I would tackle it. Start with the blaze structure of a function that takes content and produces a tag. That helps some, as it means you HTML will be properly nested. You now want types for the various types of contents: the "head" and "body" functions return an "HTML" type. "title", "meta" and others return a "HEAD" type. There are at least two types for body elements - block and inline tags. Some tags can be in multiple contexts, so you'll need polymorphic functions, which is where type classes come in. Attributes represent a different problem. They are basically lists of name/value pairs, but the set of names depends on the tag, and the valid values may as well. You can model them with product types, but that may well require a type for each tag, which would get repetitive. Some of the values can be checked, others are arbitrary strings. You might want to take a look at Graphics.OpenSCAD, which tackled a similar problem: providing type checking for 2 and 3d models that were then going to turn into CAD primitives. It has all the same elements - primitives of different types, combinations and operations of those types,some of which that to work on both types, and attributes for all of the above - but for a much less complex domain. Most notable is that not all the checking can be done at compile time. Some of it - like checking the orientation of the faces in a polyhedron - was much easier to do at generation time. -------------- next part -------------- An HTML attachment was scrubbed... URL: From frank at fstaals.net Thu Nov 13 09:11:47 2014 From: frank at fstaals.net (Frank Staals) Date: Thu, 13 Nov 2014 10:11:47 +0100 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: (James M.'s message of "Wed, 12 Nov 2014 23:47:02 -0800") References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> Message-ID: <8761ej79d8.fsf@Shanna.FStaals.net> James M writes: > This is easily testable. > > deriving instance Typeable Entry > deriving instance Typeable FileKind > deriving instance Typeable 'FOLDER > deriving instance Typeable 'FILE > > convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) > convertBack (SomeEntry x) > | typeOf x == typeOf (Folder "" "") = Right x > | otherwise = Left x If the goal is just to write the `convertBack' function with the type signature above you don't need Typeable. If you enable the GADT extension you can just pattern match on the Entry that is stored in the SomeEntry, even though they have different types: i.e. convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) convertBack (SomeEntry f@(File _ _ _)) = Left f -- By pattern matching on f we -- can convince the compiler -- that f is of type Entry FILE convertBack (SomeEntry d@(Folder _ _)) = Right d Similarly we can write a function convertAsFile :: SomeEntry -> Entry FILE convertAsFile (SomeEntry f@(File _ _ _)) = f convertAsFile (SomeEntry d) = error "We cannot convert from a Entry FOLDER" however there is no way of making that function total (i.e. in the second case there is no proper way of constructing an Entry FILE from an Entry FOLDER) Because you can (locally) recover the type by pattern matching on a GADT I prefer to use GADTs to model existential types rather than using the ExistentialTypes extension. -- - Frank From tobias.pflug at gmx.net Thu Nov 13 09:37:29 2014 From: tobias.pflug at gmx.net (Tobias Pflug) Date: Thu, 13 Nov 2014 10:37:29 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> Message-ID: <54647BD9.2090600@gmx.net> On 13.11.2014 02:22, Christopher Allen wrote: > I'm working on a Haskell article for https://howistart.org/ which is > actually about the rudiments of processing CSV data in Haskell. > > To that end, take a look at my rather messy workspace here: > https://github.com/bitemyapp/csvtest > > And my in-progress article here: > https://github.com/bitemyapp/howistart/blob/master/haskell/1/index.md > (please don't post this anywhere, incomplete!) > > And here I'll link my notes on profiling memory use with different > streaming abstractions: > https://twitter.com/bitemyapp/status/531617919181258752 > > csv-conduit isn't in the test results because I couldn't figure out > how to use it. pipes-csv is proper streaming, but uses cassava's > parsing machinery and data types. Possibly this is a problem if you > have really wide rows but I've never seen anything that would be > problematic in that realm even when I did a lot of HDFS/Hadoop > ecosystem stuff. AFAICT with pipes-csv you're streaming rows, but not > columns. With csv-conduit you might be able to incrementally process > the columns too based on my guess from glancing at the rather scary code. > > Let me know if you have any further questions. > > Cheers all. > > --- Chris Allen > > Thank you, this looks rather useful. I will have a closer look at it for sure. Surprised that csv-conduit was so troublesome. I was in fact expecting/hoping for the opposite. I will just give it a try. Thanks also to everyone else who replied. Let me add some tidbits to refine the problem space a bit. As I said before the size of the data is around 12GB of csv files. One file per month with each line representing a user tuning in to a stream: [date-time-stamp], [radio-stream-name], [duration], [mobile|desktop], [country], [areaCode] which could be represented as: data RadioStat = { rStart :: Integer -- POSIX time stamp , rStation :: Integer -- index to station map , rDuration :: Integer -- duration in seconds , rAgent :: Integer -- index to agent map ("mobile", "desktop", ..) , rCountry :: Integer -- index to country map ("DE", "CH", ..) , rArea :: Integer -- German geo location info } I guess it parsing a csv into a list of [RadioStat] list and respective entries in a HashMap for the station names should work just fine (thanks again for your linked material chris). While this is straight forward I the type of queries I got as examples might indicate that I should not try to reinvent a query language but look for something else (?). Examples would be - summarize per day : total listening duration, average listening duration, amount of listening actions - summarize per day per agent total listening duration, average listening duration, amount of listening actions I don't think MySQL would perform all that well operating on a table with 125 million entries ;] What approach would you guys take ? Thanks for your input and sorry for the broad scope of these questions. best wishes, Tobi From jmartin at eecs.berkeley.edu Thu Nov 13 09:41:51 2014 From: jmartin at eecs.berkeley.edu (James M) Date: Thu, 13 Nov 2014 01:41:51 -0800 Subject: [Haskell-cafe] Representing record subtypes, sort of. In-Reply-To: <8761ej79d8.fsf@Shanna.FStaals.net> References: <1415676739.1368137.189478737.2760A06A@webmail.messagingengine.com> <87389o23wc.fsf@Shanna.FStaals.net> <8761ej79d8.fsf@Shanna.FStaals.net> Message-ID: Interesting. I wasn't aware that you could pattern match on something with different types. This would make GADTs more useful than the ExistentialTypes extension in cases where you don't need the extensibility. James On Thu, Nov 13, 2014 at 1:11 AM, Frank Staals wrote: > James M writes: > > > This is easily testable. > > > > deriving instance Typeable Entry > > deriving instance Typeable FileKind > > deriving instance Typeable 'FOLDER > > deriving instance Typeable 'FILE > > > > convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) > > convertBack (SomeEntry x) > > | typeOf x == typeOf (Folder "" "") = Right x > > | otherwise = Left x > > > If the goal is just to write the `convertBack' function with the type > signature above you don't need Typeable. If you enable the GADT > extension you can just pattern match on the Entry that is stored in the > SomeEntry, even though they have different types: i.e. > > convertBack :: SomeEntry -> Either (Entry FILE) (Entry FOLDER) > convertBack (SomeEntry f@(File _ _ _)) = Left f > -- By pattern matching on f we > -- can convince the compiler > -- that f is of type Entry FILE > convertBack (SomeEntry d@(Folder _ _)) = Right d > > Similarly we can write a function > > convertAsFile :: SomeEntry -> Entry FILE > convertAsFile (SomeEntry f@(File _ _ _)) = f > convertAsFile (SomeEntry d) = error "We cannot convert from a Entry FOLDER" > > however there is no way of making that function total (i.e. in the > second case there is no proper way of constructing an Entry FILE from an > Entry FOLDER) > > Because you can (locally) recover the type by pattern matching on a GADT > I prefer to use GADTs to model existential types rather than using the > ExistentialTypes extension. > > -- > > - Frank > -------------- next part -------------- An HTML attachment was scrubbed... URL: From f at mazzo.li Thu Nov 13 10:08:16 2014 From: f at mazzo.li (Francesco Mazzoli) Date: Thu, 13 Nov 2014 11:08:16 +0100 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: On 13 November 2014 01:23, Chris Wong wrote: > That's different to Evan's original function. > > Evan's solution short-circuits: it does not execute the second action > if the first succeeds. But your one runs both actions unconditionally. > > For example, the expression > > try (return $ Just ()) (putStrLn "second action executed" >> return Nothing) > > outputs "second action executed" with your solution, but not with Evan's. > > The lesson is, applicative and monadic composition don't always yield > the same results. Applicative and monadic composition *should* be the same, given that Applicative contains the law (<*>) = ap And in fact if we rewrite Andras solution as try a b = (<|>) <$> a <*> b It is still broken. The fact that you find libraries where (<*>) is not ap has been confusing for me as well :P. Evan's `try` doesn't use Applicative at all, but short-circuits manually. For this kind of stuff I usually use MaybeT. Francesco From neto at netowork.me Thu Nov 13 10:07:14 2014 From: neto at netowork.me (Ernesto Rodriguez) Date: Thu, 13 Nov 2014 11:07:14 +0100 Subject: [Haskell-cafe] open-source project looking for novice help? In-Reply-To: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> References: <981FB3CF-62B2-4473-BB8D-55614D326649@cis.upenn.edu> Message-ID: <2700804.lJ7vpyY3h1@lifter> Hi Richard Eisenberg, Sorry for the late reply, but I just read this. I am not sure how important/big of a project you search for, but I a couple of tools (for my own use atm) that I develop as open-source in Haskell and would be great if they could be made more usable for the public and eventually create a Hackage package. One that might be good for a introductory FP course project is Cryptographer[1]. It's objective is to encrypt data in html files so you can publicly share those files but only ppl with the password can see the contents. The nice thing is that you can send one of those files to anyone since it's html so all you need is a browser to open it. Anyways, in my wishlist (and future steps) for this tool I have the following: * When appending data to an encrypted file, add checks to ensure the provided decryption key is correct (currently, if you give a wrong key it simply decrypts gibberish and appends your content to it) * Add support for data other than text. Ie. embed images and files by encrypting the base64 encoding of it's bits. * I use it primarily for passwords, so would be nice to add some tools for them. In particular, it would be nice if the encrypted file could contain buttons which one can click to copy passwords into clipboard. Also if it could have a setTimeout() somewhere so the file gets encrypted again after some time automatically. * Add more ciphers. Currently I encrypt data using TwoFish. I use it bc I like the cipher but also because since I use GHCJS to generate the html file that performs decryption, the cipher must be written 100% in Haskell (or do some ffi's to an external js library). I used to support BlowFish as well but I removed it since the cipher is not 100% secure. * A UI (both html and desktop) would be nice. Even if encryption could be done 100% on a HTML UI would also be advanced. But in order for appending to work over the net, code has to be added so files are retrieved via Ajax (not wget as I currently do it :P). * Improve the command line interface. I use my own experimental extension of CmdArgs for the command line (which I wrote only to try GHC Generics out). An ambitious student could consider improving that tool [2] or simply using standard cmdargs for the command line arguments. The most `advanced` library I use in the project is Pipes which is easy to gasp and a lot of the code is pure code (ie. encryption algorithms, generating html, ect) so that makes things simple as well. Hope to hear from you and best regards, Ernesto Rodriguez Master's Student Utrecht University [1] On Friday, November 07, 2014 01:40:00 PM Richard Eisenberg wrote: > I'm teaching an introductory Haskell course this semester > (http://cis.upenn.edu/~cis194/fall14/) and am about to assign students > their final project. Is there anyone out there who would welcome getting > some novice help on an open-source project? You certainly don't need to > commit to accept their patch(es), but I know it would be a great experience > for some of the students to contribute to the "real" world of Haskell, > instead of just doing exercises. You can get an accurate summary of what > we've covered by looking at the lecture titles at > http://cis.upenn.edu/~cis194/fall14/lectures.html > > Students will be choosing projects starting next week, and will need to have > them completed by Dec. 15 or so. A good project is about 20 hours of work. > > Thanks! > Richard From alexander at plaimi.net Thu Nov 13 10:11:51 2014 From: alexander at plaimi.net (Alexander Berntsen) Date: Thu, 13 Nov 2014 11:11:51 +0100 Subject: [Haskell-cafe] Presenting at Royal Holloway Colloquium In-Reply-To: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> References: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> Message-ID: <546483E7.50702@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 On 12/11/14 13:41, Dominic Steinitz wrote: > E.g. if openssl were written in Haskell ... timing attacks would be trivial. You could argue to use things like Cryptol where it makes sense to use them. But remember that Haskell is not a silver bullet for security. - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 Comment: Using GnuPG with Thunderbird - http://www.enigmail.net/ iF4EAREIAAYFAlRkg+cACgkQRtClrXBQc7WswQD/bCifZHMTLPjoz/St1yorc66f wG7nAJWlMrhVTshY1EQA/1zqFltpGjgbGJ4N9PFOpHpcZIAm97wuB7EOHQM0EfbJ =HJPM -----END PGP SIGNATURE----- From lambda.fairy at gmail.com Thu Nov 13 10:52:21 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Thu, 13 Nov 2014 23:52:21 +1300 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: > Applicative and monadic composition *should* be the same, given that > Applicative contains the law > > (<*>) = ap Ah, I probably wasn't too clear with that last comment. What I meant by "applicative and monadic composition don't always yield the same result" is that Compose m Maybe and MaybeT m are *not* interchangeable, despite their unwrapped types being the same. As you point out, the latter short-circuits but the former does not. I guess a better wording is that there is often more than one way to compose things. (Compose is from Data.Functor.Compose in the transformers package.) Chris > And in fact if we rewrite Andras solution as > > try a b = (<|>) <$> a <*> b > > It is still broken. > > The fact that you find libraries where (<*>) is not ap has been > confusing for me as well :P. > > Evan's `try` doesn't use Applicative at all, but short-circuits > manually. For this kind of stuff I usually use MaybeT. > > Francesco -------------- next part -------------- An HTML attachment was scrubbed... URL: From jon.fairbairn at cl.cam.ac.uk Thu Nov 13 11:03:44 2014 From: jon.fairbairn at cl.cam.ac.uk (Jon Fairbairn) Date: Thu, 13 Nov 2014 11:03:44 +0000 Subject: [Haskell-cafe] Generating valid html References: <5463E2D3.7040305@power.com.pl> <54640451.88f43c0a.7650.1457@mx.google.com> <5464696A.7060808@power.com.pl> Message-ID: Wojtek Narczy?ski writes: > On 13.11.2014 02:07, Christopher Reichert wrote: >> >> I'm not sure if it fits all your criteria but BlazeHtml might interest you. >> >> https://hackage.haskell.org/package/blaze-html >> > My question is how to capture (at least some of) the HTML > validity rules in Haskell types, or classes, or families, or > whatever. I have a library that does pretty much all of that. For your entertainment I?ve put a bundle of it here: http://scrap.bookofsand.co.uk/HTMLs.tar.gz, it?s not caballized so you may have to ask me how to build it if gmake doesn?t work. I haven?t tried it with anything newer than ghc 7.6.3 It?s semi-mechanically derived from the definition of xhtml 1.0 with reference to the description of html 4. Since the formal documents are not normative, it wasn?t a mechanical translation. I couldn?t do the same for html5 because there is no standard. The problem with it (why I haven?t released it) is that because all the checks are done in the type system, the error messages that result from attempting to make bad html can be difficult to comprehend; I sometimes end up interpreting a type error as ?there?s a mistake? and looking at the code for mistakes without trying to work out what the type error means. -- J?n Fairbairn Jon.Fairbairn at cl.cam.ac.uk From ollie at ocharles.org.uk Thu Nov 13 11:32:33 2014 From: ollie at ocharles.org.uk (Oliver Charles) Date: Thu, 13 Nov 2014 11:32:33 +0000 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <5463E2D3.7040305@power.com.pl> References: <5463E2D3.7040305@power.com.pl> Message-ID: <87mw7v49pq.fsf@fynder-widget.localhost> Wojtek Narczy?ski writes: > Hello list, > > I have a question. > > How to create a DSL for HTML generation, that would (statically) allow > only valid HTML to be generated? Parent - child relations, valid > attributes only. > > Or does such a DSL already exist, perhaps? I remember that when I was first interested in Haskell, this was something that I really wanted. While it's a couple of years ago now, I think all I could find were a few papers/student projects that explored the idea, but nothing "production ready." I think to get something that satisfies the HTML schema under *any* construction should be a more achievable goal with all the features we have in GHC 7.8, and I might try exploring it again. I think you could do something a lot like blaze, but work with a very rich GADT under-the-hood to carry properties of the schema around. I appreciate this is mostly rambling; I don't have anything I point you to off hand :) - ocharles From alfredo.dinapoli at gmail.com Thu Nov 13 13:39:41 2014 From: alfredo.dinapoli at gmail.com (Alfredo Di Napoli) Date: Thu, 13 Nov 2014 14:39:41 +0100 Subject: [Haskell-cafe] How is maintaining the iCalendar package? In-Reply-To: <87k32z49of.fsf@fynder-widget.localhost> References: <87k32z49of.fsf@fynder-widget.localhost> Message-ID: Sure thing, I contacted him only yesterday and I'm willing to wait a couple of weeks before asking again, was just a bit concerned about the lack of activity on Github since August. Thanks Ollie! Alfredo On Thursday, 13 November 2014, Oliver Charles wrote: > Alfredo Di Napoli writes: > >> Hello fellow Haskellers, >> >> anybody knows who is maintaining >> >> https://github.com/tingtun/iCalendar >> >> ? >> >> I have tried to email the maintainer listed on Github, but his activity >> seems quite low. >> Posting it here hoping to get a bit more resonance. > > I sent some patches a few months ago and got them merged promptly - > maybe give it a bit longer? > > - ocharles > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Thu Nov 13 14:30:50 2014 From: gale at sefer.org (Yitzchak Gale) Date: Thu, 13 Nov 2014 16:30:50 +0200 Subject: [Haskell-cafe] Using multiple versions of the Haskell Platform on Windows In-Reply-To: References: Message-ID: Thanks. We also should improve on what the installer does to the PATH in previous of existing HP installations. And provide a similar utility for choosing the default HP (not just in the current window) by changing the PATH in ther registry. I took a stab at this last one, but didn't have it working yet due to getting registry permissions wrong. You can see it in older commits in the win-hp-path repo on github. Neil Mitchell pointed out in the reddit thread that this utility actually isn't specific to HP - it can be used to choose between different GHC versions regardless of whether they are part of HP installations. But that is not for the faint of heart. Regards, Yitz On Wed, Nov 12, 2014 at 3:18 PM, Mikhail Glushenkov wrote: > Hi, > > On 12 November 2014 03:43, Yitzchak Gale wrote: >> The win-hp-path project provides the use-hp command, >> which makes it easy to switch between different versions >> of Haskell Platform on Windows. >> >> https://github.com/ygale/win-hp-path > > Very nice! This should be added to the official installer. There's a > ticket already: https://github.com/haskell/haskell-platform/issues/56 From haskell-cafe at accounts.gphilip.in Thu Nov 13 14:41:44 2014 From: haskell-cafe at accounts.gphilip.in (G Philip) Date: Thu, 13 Nov 2014 15:41:44 +0100 Subject: [Haskell-cafe] xs not in scope In-Reply-To: <545FA01C.1020108@home.nl> References: <545F9882.6080806@home.nl> <20141109180440.25d3cba3@with-eyes.net> <545FA01C.1020108@home.nl> Message-ID: <1415889704.3352951.190581845.0D8D8F95@webmail.messagingengine.com> On Sun, Nov 9, 2014, at 06:10 PM, Roelof Wobben wrote: > So this cannot be done with guards ? Here is one way to do this "with guards": last3 :: [a] -> Maybe a; last3 [] = Nothing last3 lst@(x:xs) | (null xs) = Just x | otherwise = last3 xs Regards, Philip > > Roelof > > > Max Voit schreef op 9-11-2014 18:04: > > Hi Roelof, > > > > the problem is, you cannot pattern-match within guards. Guards take > > predicates. > > > > On your example: "last3 a" pattern-matches the first argument of last3 > > into a. You may now use a in all further statements. If, however, you > > want to do pattern matching, it would look like this: > > > > last3::[a]-> Maybe a; > > last3 [] = Nothing > > last3 ([a]) = Just a > > last3 (_:xs) = last3 xs > > > > Notice that the last case will never be executed, as the matching is > > complete with the first two case. > > > > Max > > > > Am Sun, 09 Nov 2014 17:38:26 +0100 > > schrieb Roelof Wobben : > > > >> Hello, > >> > >> Im trying to find several answers to problem1 of the 99 haskell > >> problems. Find the last item in a list. > >> > >> Now im trying to find a guarded solution. > >> So far I have this: > >> > >> last3::[a]-> Maybe a; > >> last3 a > >> | [] = Nothing > >> | ([a]) = Just a > >> | (_:xs) = last3 xs > >> > >> But I see this error messages : > >> > >> src/Main.hs at 10:8-10:10Not in scope: xs > >> > >> How to solve this ? > >> > >> Roelof > >> > >> > >> _______________________________________________ > >> Haskell-Cafe mailing list > >> Haskell-Cafe at haskell.org > >> http://www.haskell.org/mailman/listinfo/haskell-cafe > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From cma at bitemyapp.com Thu Nov 13 16:49:38 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Thu, 13 Nov 2014 10:49:38 -0600 Subject: [Haskell-cafe] data analysis question In-Reply-To: <54647BD9.2090600@gmx.net> References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> Message-ID: I wouldn't hold it against csv-conduit too much, conduit and Pipes both take some getting used too and I hadn't used either in anger before I started kicking around the CSV parsing stuff. I was a bit spoiled by how easy Cassava was to use as well. Thanks to Christopher Reichert's PR, there is an example for csv-conduit as well, so you've now got four ways to try processing CSV, *three* of which are streaming :) I'd say just try each in turn and see what you're happy with, if you're not married to a particular streaming operation. >I don't think MySQL would perform all that well operating on a table with 125 million entries ;] What approach would you guys take ? Big enough machine with enough memory and it's fine. I used to keep a job queue with a billion rows on MySQL at a gig long ago. Could do it with PostgreSQL pretty easily too. On your personal work machine? I dunno. Not trying to steer you away from using Haskell here by any means, but if you can process your data in a SQL database efficiently, that's often pretty optimal in terms of speed and ease of use until you start doing more sophisticated analysis. I don't have a lot of experience in data analysis but I knew people to do some preliminary slicing/dicing in SQL before moving onto a building a custom model for understanding the data. Cheers, Chris Allen On Thu, Nov 13, 2014 at 3:37 AM, Tobias Pflug wrote: > On 13.11.2014 02:22, Christopher Allen wrote: > >> I'm working on a Haskell article for https://howistart.org/ which is >> actually about the rudiments of processing CSV data in Haskell. >> >> To that end, take a look at my rather messy workspace here: >> https://github.com/bitemyapp/csvtest >> >> And my in-progress article here: https://github.com/bitemyapp/ >> howistart/blob/master/haskell/1/index.md (please don't post this >> anywhere, incomplete!) >> >> And here I'll link my notes on profiling memory use with different >> streaming abstractions: https://twitter.com/bitemyapp/ >> status/531617919181258752 >> >> csv-conduit isn't in the test results because I couldn't figure out how >> to use it. pipes-csv is proper streaming, but uses cassava's parsing >> machinery and data types. Possibly this is a problem if you have really >> wide rows but I've never seen anything that would be problematic in that >> realm even when I did a lot of HDFS/Hadoop ecosystem stuff. AFAICT with >> pipes-csv you're streaming rows, but not columns. With csv-conduit you >> might be able to incrementally process the columns too based on my guess >> from glancing at the rather scary code. >> >> Let me know if you have any further questions. >> >> Cheers all. >> >> --- Chris Allen >> >> >> Thank you, this looks rather useful. I will have a closer look at it for > sure. Surprised that csv-conduit was so troublesome. I was in fact > expecting/hoping for the opposite. I will just give it a try. > > Thanks also to everyone else who replied. Let me add some tidbits to > refine the problem space a bit. As I said before the size of the data is > around 12GB of csv files. One file per month with > each line representing a user tuning in to a stream: > > [date-time-stamp], [radio-stream-name], [duration], [mobile|desktop], > [country], [areaCode] > > which could be represented as: > > data RadioStat = { > rStart :: Integer -- POSIX time stamp > , rStation :: Integer -- index to station map > , rDuration :: Integer -- duration in seconds > , rAgent :: Integer -- index to agent map > ("mobile", "desktop", ..) > , rCountry :: Integer -- index to country map > ("DE", "CH", ..) > , rArea :: Integer -- German geo location info > } > > I guess it parsing a csv into a list of [RadioStat] list and respective > entries in a HashMap for the station names > should work just fine (thanks again for your linked material chris). > > While this is straight forward I the type of queries I got as examples > might indicate that I should not try to > reinvent a query language but look for something else (?). Examples would > be > > - summarize per day : total listening duration, average listening > duration, amount of listening actions > - summarize per day per agent total listening duration, average listening > duration, amount of listening actions > > I don't think MySQL would perform all that well operating on a table with > 125 million entries ;] What approach > would you guys take ? > > Thanks for your input and sorry for the broad scope of these questions. > best wishes, > Tobi > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tobias.pflug at gmx.net Thu Nov 13 18:46:24 2014 From: tobias.pflug at gmx.net (Tobias Pflug) Date: Thu, 13 Nov 2014 19:46:24 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> Message-ID: <5464FC80.8090608@gmx.net> > > Big enough machine with enough memory and it's fine. I used to keep a > job queue with a billion rows on MySQL at a gig long ago. Could do it > with PostgreSQL pretty easily too. On your personal work machine? I dunno. > > Not trying to steer you away from using Haskell here by any means, but > if you can process your data in a SQL database efficiently, that's > often pretty optimal in terms of speed and ease of use until you start > doing more sophisticated analysis. I don't have a lot of experience in > data analysis but I knew people to do some preliminary slicing/dicing > in SQL before moving onto a building a custom model for understanding > the data. I guess I was just curious what a sensible approach using Haskell would look like and i'll play around with what I know now. If this was from my working place i'd just put it in a database with enough horse power but it's just my curiosity in my spare time, alas.. thank you for your input. -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Thu Nov 13 18:49:49 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Thu, 13 Nov 2014 10:49:49 -0800 Subject: [Haskell-cafe] [ANN] Haskell FFI Tutorial In-Reply-To: <20141113062340.77BAA93C2E@mail.avvanta.com> References: <20141113062340.77BAA93C2E@mail.avvanta.com> Message-ID: On Wed, Nov 12, 2014 at 10:23 PM, Donn Cave wrote: > Maybe it does, and I only need a clue to the syntax. I have seen > it used only for the size of the struct; I'm looking for the size > of a field - and devoid of parentheses or other adornments, so I > can tack it onto something like Word or Int. You could define > type aliases for other variable-size foreign types, like Float8 > etc. and use #fieldsize to select them. Oh I see. Maybe this: #let fieldsize t, f = "%lu", (unsigned long)sizeof(((t *)0)->f) c :: Word#{fieldsize example, c} Of course you will wind up with Word64 for a double which is not that great, and you lose signedness. The hsc_type macro has some ridiculous but effective hackery to figure that out. So I bet a #fieldtype macro can be defined without too much trouble, perhaps without even having to modify hsc2hs. > I don't know language-c. Lots of interesting potential there > if it works well. Just because I was curious, I wrote up an implementation last night. It converts: typedef int xy_t; struct example { xy_t a; }; to module Example_generated where import qualified Example as M #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -- struct example sizeOf_example :: Int sizeOf_example = #size example alignment_example :: Int alignment_example = #{alignment example} poke_example_a :: (#type xy_t) -> Ptr M.Example -> IO () poke_example_a = (#poke example, a) peek_example_a :: Ptr M.Example -> IO (#type xy_t) peek_example_a = (#peek example, a) Of course now it occurs to me that if instead I emitted the typedef as 'type Xy_t = CInt' then I could hardcode the primitive C types and not need #type anymore. I'd want to emit type synonyms anyway for function typedefs. And naturally further complexity is in store for declarations like 'char c, *const *s'. One thing is I just ignore unnamed structs, since I couldn't figure out how to write a #poke for them. And then of course I want to filter by header so I don't always generate 50 zillion declarations from system headers, and now using #type instead of type synonyms looks better, otherwise I wind up needing hs versions of all system headers. So it seems feasible, but is naturally fraught with details that will turn it into a real project rather than a quick hack. Since I don't really plan to write any more FFIs in the near future, that's where I'll leave it :) Your #fieldtype macro certainly seems more practical to get something useful working quickly. From aranea at aixah.de Thu Nov 13 18:51:35 2014 From: aranea at aixah.de (Luis Ressel) Date: Thu, 13 Nov 2014 19:51:35 +0100 Subject: [Haskell-cafe] Presenting at Royal Holloway Colloquium In-Reply-To: <546483E7.50702@plaimi.net> References: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> <546483E7.50702@plaimi.net> Message-ID: <20141113195135.3592c9d5@gentp.lnet> On Thu, 13 Nov 2014 11:11:51 +0100 Alexander Berntsen wrote: > On 12/11/14 13:41, Dominic Steinitz wrote: > > E.g. if openssl were written in Haskell > ... timing attacks would be trivial. In fact, I bet the majority of cryptographic code written in Haskell is susceptible to sidechannel attacks. -- Luis Ressel GPG fpr: F08D 2AF6 655E 25DE 52BC E53D 08F5 7F90 3029 B5BD From qdunkan at gmail.com Thu Nov 13 18:56:57 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Thu, 13 Nov 2014 10:56:57 -0800 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <5463E2D3.7040305@power.com.pl> References: <5463E2D3.7040305@power.com.pl> Message-ID: On Wed, Nov 12, 2014 at 2:44 PM, Wojtek Narczy?ski wrote: > How to create a DSL for HTML generation, that would (statically) allow only > valid HTML to be generated? Parent - child relations, valid attributes only. > > Or does such a DSL already exist, perhaps? WASH did that, a long time ago. They mentioned that they intentionally relaxed the rules, since being totally correct was annoying to actually use. There are docs here: http://www2.informatik.uni-freiburg.de/~thiemann/WASH/ Tested with ghc-6.6! It didn't seem to catch on, so maybe it was too heavy for its benefits. From 0slemi0 at gmail.com Thu Nov 13 19:23:12 2014 From: 0slemi0 at gmail.com (Andras Slemmer) Date: Thu, 13 Nov 2014 20:23:12 +0100 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: > Evan's solution short-circuits: it does not execute the second action if the first succeeds. But your one runs both actions unconditionally. Thanks for pointing that out! This is what happens when you only look at the type of a function and *assume* its implementation:) Actually this is a great way to shed light on the difference between monadic and applicative: In the original function the context chaining itself depends on a computed value (short circuiting), meaning it "properly" relies on (>>=). liftM2 (<|>) - or rather liftA2 (<|>) - does not, it doesn't unbox anything, so it cannot possibly be correct. On 13 November 2014 01:23, Chris Wong wrote: > On Thu, Nov 13, 2014 at 11:07 AM, Andras Slemmer <0slemi0 at gmail.com> > wrote: > > Well, "try" is really doing two things: chaining Maybes, and then adding > a > > monadic context: > > try :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) > > try = liftM2 (<|>) > > (You could weaken the assumption by using (Applicative m) instead) > > That's different to Evan's original function. > > Evan's solution short-circuits: it does not execute the second action > if the first succeeds. But your one runs both actions unconditionally. > > For example, the expression > > try (return $ Just ()) (putStrLn "second action executed" >> return > Nothing) > > outputs "second action executed" with your solution, but not with Evan's. > > The lesson is, applicative and monadic composition don't always yield > the same results. > > Chris > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mwm at mired.org Thu Nov 13 21:15:36 2014 From: mwm at mired.org (Mike Meyer) Date: Thu, 13 Nov 2014 15:15:36 -0600 Subject: [Haskell-cafe] Fwd: Generating valid html In-Reply-To: References: <5463E2D3.7040305@power.com.pl> Message-ID: On Thu, Nov 13, 2014 at 12:56 PM, Evan Laforge wrote: > On Wed, Nov 12, 2014 at 2:44 PM, Wojtek Narczy?ski > wrote: > > How to create a DSL for HTML generation, that would (statically) allow > only > > valid HTML to be generated? Parent - child relations, valid attributes > only. > > > > Or does such a DSL already exist, perhaps? > > WASH did that, a long time ago. They mentioned that they > intentionally relaxed the rules, since being totally correct was > annoying to actually use. There are docs here: > http://www2.informatik.uni-freiburg.de/~thiemann/WASH/ > Well, a lot of folks felt that any validation beyond "it works in my browser" was annoying to actually use. I, on the other hand, used NSGML in emacs and the actual DTD without much problem. But there were multiple DTDs, some of which also relaxed things because so many people felt the strict rules were annoying to actually use. It didn't seem to catch on, so maybe it was too heavy for its benefits. > Based on a decade of trying to get people to write valid HTML - so that it would work in browsers other than the most popular two or three on the most popular two or three platforms - most people don't care about "correct".. I've had people - including employees of the FSF, who I would expect otherwise from - tell me that their HTML was tested on some limited set of browser/platform pairs when I pointed out it was incorrect and hence broke on some obscure browser/platform combination. Or even on one of those browser/platform pairs with a configuration change. This also seems to be true in the Haskell community. The web platforms help catching the obvious problems you find testing against a browser. But - like most popular web platforms - break the tools that help with the creation of valid HTML Validating HTML against a DTD is much easier than doing so against browsers, but my clients never did it unless I set it up for them. Doing so helped find more than one really obscure bug, and on one occasion kept my clients web site working when a major browser tweaked how it handled broken code and broke a lot of web sites. I think this may be related to why ADTs are a hard sell. While they help a lot writing correct programs, but for just writing working programs not so much. -------------- next part -------------- An HTML attachment was scrubbed... URL: From codygman.consulting at gmail.com Thu Nov 13 22:14:25 2014 From: codygman.consulting at gmail.com (Cody Goodman) Date: Thu, 13 Nov 2014 16:14:25 -0600 Subject: [Haskell-cafe] Mechanize in Haskell or Revive Shpider? Message-ID: What would be a good way to model mechanize in Haskell? For instance the python mechanize example is quite simple: def google_search(keyword): br = mechanize.Browser() br.open("https://www.google.com") br.select_form(name="gbqf") br["q"] = keyword response = br.submit() print html_to_text(response.read()) I was thinking I could just use a StateT monad transformer with the current pages html as a cursor. Then have something like: get "http://www.google.com" >>= (\c -> c $// form (Name "gbqf") >=> input (Name "q") &| submit . modifyVal "query" "Haskell") That's kinda horrible but it's a place to start. Or would I be better off trying to revive Shpider? From qdunkan at gmail.com Thu Nov 13 23:36:41 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Thu, 13 Nov 2014 15:36:41 -0800 Subject: [Haskell-cafe] Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) In-Reply-To: References: <20141111171856.GM31823@weber> Message-ID: On Thu, Nov 13, 2014 at 11:23 AM, Andras Slemmer <0slemi0 at gmail.com> wrote: > Actually this is a great way to shed light on the difference between monadic > and applicative: In the original function the context chaining itself > depends on a computed value (short circuiting), meaning it "properly" relies > on (>>=). liftM2 (<|>) - or rather liftA2 (<|>) - does not, it doesn't unbox > anything, so it cannot possibly be correct. That's what I meant by "I think 'm' has to be a monad", sorry if I wasn't clear! I admit I'm weak on Alternative, and haven't really found many uses for it, other than the parser combinator thing, so the conversation was interesting anyway. Come to think of it I've used (<|>) for choice and mzero for failure in parsers, so that's really confusing, why one of each? Perhaps because parsec predates Applicative and Alternative. I'm also not too clear on the uses of MonadPlus, aside from being the pure version of my 'try' function, or the relation between Alternative and MonadPlus. There was some discussion recently with the whole AMP thing that implied that it's a historical relic of Applicative coming after Monad, but then some implication that maybe it's not. I guess you'd need a MonadPlus if choice relied on the value inside, but presumably if there's an Alternative, then MonadPlus should have the same implementation. From mark.m.fredrickson at gmail.com Fri Nov 14 03:40:50 2014 From: mark.m.fredrickson at gmail.com (Mark Fredrickson) Date: Thu, 13 Nov 2014 21:40:50 -0600 Subject: [Haskell-cafe] data analysis question In-Reply-To: <5464FC80.8090608@gmx.net> References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> Message-ID: Is there a mailing list for statistics/analytics/simulation/numerical analysis/etc. using Haskell? If not, I purpose we start one. (Not to take away from general discussion, but to provide a forum to hash out these issues among the primary user base). -M On Thu, Nov 13, 2014 at 12:46 PM, Tobias Pflug wrote: > > > Big enough machine with enough memory and it's fine. I used to keep a job > queue with a billion rows on MySQL at a gig long ago. Could do it with > PostgreSQL pretty easily too. On your personal work machine? I dunno. > > Not trying to steer you away from using Haskell here by any means, but if > you can process your data in a SQL database efficiently, that's often pretty > optimal in terms of speed and ease of use until you start doing more > sophisticated analysis. I don't have a lot of experience in data analysis > but I knew people to do some preliminary slicing/dicing in SQL before moving > onto a building a custom model for understanding the data. > > > I guess I was just curious what a sensible approach using Haskell would look > like and i'll play > around with what I know now. If this was from my working place i'd just put > it in a database with > enough horse power but it's just my curiosity in my spare time, alas.. > > thank you for your input. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From quentin.leguennec1 at gmail.com Fri Nov 14 09:26:40 2014 From: quentin.leguennec1 at gmail.com (Quentin Le Guennec) Date: Fri, 14 Nov 2014 10:26:40 +0100 Subject: [Haskell-cafe] Programming videogames in haskell Message-ID: Hello, We're building a indie game studio with some friends. I am the lead developper and i am planning to write the game logic and graphics in haskell. I would like to know if some of you have some experience in game developpement in haskell, functionnal reactive programming in particular. Furthermore, knowing which tools/DSL's/libraries i could use and where to get good documentation could really help me. Elise Huard recently wrote an ebook about game programming in haskell, did some of you read it ? Is it worth buying it ? Thanks for your feedback. -- Quentin Le Guennec -------------- next part -------------- An HTML attachment was scrubbed... URL: From zhangjun.julian at gmail.com Fri Nov 14 09:43:15 2014 From: zhangjun.julian at gmail.com (zhangjun.julian) Date: Fri, 14 Nov 2014 17:43:15 +0800 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? Message-ID: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> Dear cafe I have 2 file, I want zip the 2 file as couple, and then count each couple's repeat times? The file had more than 40M rows, I use pipe to write code as blow. When I test with 8768000 rows input, it take 30 secs When I test with 18768000 rows input, it take 74 secs But when I test with whole file (40M rows), it take more than 20 minutes and not finished yet. It take more than 9G memorys, and the disk is also busy all time. The result will less than 10k rows, so I had no idea why the memory is so huge. I had use the ?http://hackage.haskell.org/package/visual-prof? to profile and improve the performance with the small file But I don?t know how to deal with the ?hang? situation. Anyone can give me some help, Thanks. =================================== import System.IO import System.Environment import Pipes import qualified Pipes.Prelude as P import qualified Data.Map as DM import Data.List emptyMap = DM.empty::(DM.Map (String,String) Int) keyCount num = do readHandle1 <- openFile "dataByColumn/click" ReadMode readHandle2 <- openFile "dataByColumn/hour" ReadMode writeHadle <- openFile "output" AppendMode rCount num readHandle1 readHandle2 writeHadle hClose writeHadle hClose readHandle1 hClose readHandle2 mapToString::DM.Map (String,String) Int-> String mapToString m = unlines $ map eachItem itemList where itemList = DM.toList m eachItem ((x,y),i) = show x ++ "," ++ show y ++ "," ++ show i --rCount::Int -> [String] -> Handle->Handle -> IO() rCount num readHandle1 readHandle2 writeHadle = do rt <- P.fold (\x y -> DM.unionWith (+) x y) emptyMap id $ P.zipWith (\x y -> DM.singleton (x,y) 1) (P.fromHandle readHandle1) (P.fromHandle readHandle2) >-> P.take num hPutStr writeHadle $ mapToString rt main = do s<- getArgs let num = (read . head) s keyCount num From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Nov 14 09:52:49 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 14 Nov 2014 09:52:49 +0000 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> Message-ID: <20141114095249.GD4785@weber> On Fri, Nov 14, 2014 at 05:43:15PM +0800, zhangjun.julian wrote: > But when I test with whole file (40M rows), it take more than 20 minutes and not finished yet. > It take more than 9G memorys, and the disk is also busy all time. > import qualified Data.Map as DM At the very least you should be using import qualified Data.Map.Strict as DM From kaspar.emanuel at gmail.com Fri Nov 14 11:17:48 2014 From: kaspar.emanuel at gmail.com (Kaspar Emanuel) Date: Fri, 14 Nov 2014 11:17:48 +0000 Subject: [Haskell-cafe] Programming videogames in haskell In-Reply-To: References: Message-ID: Check out Elm and then Helm is my recommendation. It's FRP while avoiding the heavy theory. -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicola.gigante at gmail.com Fri Nov 14 11:30:20 2014 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Fri, 14 Nov 2014 12:30:20 +0100 Subject: [Haskell-cafe] Correct implementation of ListT besides the pipes package? Message-ID: <838169A9-B72B-485E-AEF7-0F3875B3F5D9@gmail.com> Hi! I understand the code on the wiki about what is wrong about the standard ListT and how to implement a correct version, but I?m wondering if there is already a package that provides such an implementation ready to use. I know the pipes package provides one, but since I don?t otherwise use pipes in my program I?d rather not depend on a big library like that only for a transformer. Is there any package that provides a correct ListT? Side question: is there a particular reason why Control.Monad.ListT doesn?t get fixed? Thank you, NIcola From bneijt at gmail.com Fri Nov 14 12:00:35 2014 From: bneijt at gmail.com (Bram Neijt) Date: Fri, 14 Nov 2014 13:00:35 +0100 Subject: [Haskell-cafe] Programming videogames in haskell In-Reply-To: References: Message-ID: The examples for the sodium FRP library contain a game like poodle clicking application. I've created a cabal file for it, you could git clone https://github.com/bneijt/poodle.git and then you should be able to "cabal run" the poodle game. The code is from the Sodium FRP library: https://github.com/SodiumFRP/sodium Greetings, Bram -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivan.perez at keera.co.uk Fri Nov 14 12:13:03 2014 From: ivan.perez at keera.co.uk (Ivan Perez) Date: Fri, 14 Nov 2014 12:13:03 +0000 Subject: [Haskell-cafe] Programming videogames in haskell In-Reply-To: References: Message-ID: Hi Quentin, This is precisely what we are doing (see [1, 2, 3, 4] for examples of Haskell on Android). There a few games over there, and videos of a fully-working graphic adventure game IDE and engine. A shorter version of a sample game has been released as open source [5]. It uses SDL for multimedia and Yampa for game logic and physics. You can control it with a mouse or a wiimote. I have a version that can be controlled with a kinect. Yampa has its own mailing list, where real FRP experts are listening. I am not one such expert, but as the current maintainer of Yampa, so you can also email me directly. Our internal version uses SDL2 for graphics, because that works better than SDL1.2 on Android. The repositories for SDL2 are *not* the ones on hackage, but others on github. I can send you the links. On desktop, we are currently running at 720 FPS with a standard machine (over 200FPS more than when the blog posts were published). There is plenty of room for further improvement, both on desktop and on android (currently rendering at 60 FPS). The reason for using SDL instead of OpenGL is that it works well, it provides a higher-level API, and creating 2D graphics is cheaper for us. Nothing stops you from using OpenGL. If you choose to do so, I personally found "Beautiful code, Compelling evidence" [6] to be one of the most amazing introductions to Haskell multimedia I have ever read. Also, make sure you take a look at Nikki and the Robots. You might want to read about the company behind it, or get in touch with them. I heard about Elise Huard. Did she finish the book? I thought she was still working on it. I wish you a busy weekend :) Ivan [1] http://keera.co.uk/blog/2014/08/13/most-inspiring-green-screen-you-will-ever-see/ [2] http://keera.co.uk/blog/2014/10/15/from-60-fps-to-500/ [3] http://keera.co.uk/blog/2014/10/18/par-thy-android-followup-60-fps-500/ [4] https://www.youtube.com/user/KeeraStudios [5] https://github.com/ivanperez-keera/haskanoid [6] http://www.renci.org/wp-content/pub/tutorials/BeautifulCode.pdf On 14 November 2014 09:26, Quentin Le Guennec wrote: > Hello, > > We're building a indie game studio with some friends. I am the lead > developper and i am planning to write the game logic and graphics in > haskell. I would like to know if some of you have some experience in game > developpement in haskell, functionnal reactive programming in particular. > > Furthermore, knowing which tools/DSL's/libraries i could use and where to > get good documentation could really help me. Elise Huard recently wrote an > ebook about game programming in haskell, did some of you read it ? Is it > worth buying it ? > > Thanks for your feedback. > > -- > Quentin Le Guennec > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominic at steinitz.org Fri Nov 14 12:28:46 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Fri, 14 Nov 2014 12:28:46 +0000 (UTC) Subject: [Haskell-cafe] Presenting at Royal Holloway Colloquium References: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> <546483E7.50702@plaimi.net> Message-ID: Alexander Berntsen plaimi.net> writes: > > > On 12/11/14 13:41, Dominic Steinitz wrote: > > E.g. if openssl were written in Haskell > ... timing attacks would be trivial. > > You could argue to use things like Cryptol where it makes sense to use > them. But remember that Haskell is not a silver bullet for security. I think it would be straightforward to circumvent timing attacks. Clearly there are other attack modes as well and it would be interesting to see how easily these could be addressed in Haskell. Interestingly I just found this: http://www.mitls.org/wsgi/home which uses F#. I hope I didn't claim that Haskell was a silver bullet for security. At the very least, it certainly couldn't address bugs in protocols although it might help in finding them. From alexander at plaimi.net Fri Nov 14 13:01:58 2014 From: alexander at plaimi.net (Alexander Berntsen) Date: Fri, 14 Nov 2014 14:01:58 +0100 Subject: [Haskell-cafe] Presenting at Royal Holloway Colloquium In-Reply-To: References: <6ADD4F2E-32C8-43CE-9608-82190DA0ECEB@steinitz.org> <546483E7.50702@plaimi.net> Message-ID: <5465FD46.7040403@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 On 14/11/14 13:28, Dominic Steinitz wrote: > I think it would be straightforward to circumvent timing attacks. [Citation needed] It would be straightforward to prevent the OpenSSL bugs as well, for some value of "straightforward". For cryptography, I think the most interesting approach would be to use Haskell where possible, and a non-GC RTS where necessary. Note that code for the non-GC RTS could conceivably be written in a Haskell DSL. - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 Comment: Using GnuPG with Thunderbird - http://www.enigmail.net/ iF4EAREIAAYFAlRl/UYACgkQRtClrXBQc7XKrwD+PQ6PnHARZXqRJvzGJDAAXyb0 i1hIobU/QwKH9beEMhEA/0fNsFjJkKTEKjTaex5Age6fw7E6+ShFWipIC3IwVAfU =6SPZ -----END PGP SIGNATURE----- From zhangjun.julian at gmail.com Fri Nov 14 13:14:17 2014 From: zhangjun.julian at gmail.com (zhangjun.julian) Date: Fri, 14 Nov 2014 21:14:17 +0800 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <20141114095249.GD4785@weber> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <20141114095249.GD4785@weber> Message-ID: <7BA816A7-999F-4A85-BAB5-428AA6AF5BC6@gmail.com> Dear Tom I change Map to Strict?it be little fast when test with 18M rows, but it hanged again with 40M rows. Do you have any other advice? > ? 2014?11?14????5:52?Tom Ellis ??? > > On Fri, Nov 14, 2014 at 05:43:15PM +0800, zhangjun.julian wrote: >> But when I test with whole file (40M rows), it take more than 20 minutes and not finished yet. >> It take more than 9G memorys, and the disk is also busy all time. > >> import qualified Data.Map as DM > > At the very least you should be using > > import qualified Data.Map.Strict as DM > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Nov 14 13:51:20 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 14 Nov 2014 13:51:20 +0000 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <7BA816A7-999F-4A85-BAB5-428AA6AF5BC6@gmail.com> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <20141114095249.GD4785@weber> <7BA816A7-999F-4A85-BAB5-428AA6AF5BC6@gmail.com> Message-ID: <20141114135120.GE4785@weber> On Fri, Nov 14, 2014 at 09:14:17PM +0800, zhangjun.julian wrote: > Dear Tom > > I change Map to Strict?it be little fast when test with 18M rows, but it hanged again with 40M rows. > > Do you have any other advice? Dear Zhangjun Julian, Perhaps too much of the output string is being kept around when it is printed. I would try mapM_ (\((x,y), i) -> hPutStrLn writeHadle (show x ++ "," ++ show y ++ "," ++ show i)) (DM.toList rt) instead of hPutStr writeHadle $ mapToString rt Apart from that, I don't have any other ideas. Can you determine whether the large memory usage comes from the Pipe or from the printing of the result? Tom From lsp at informatik.uni-kiel.de Fri Nov 14 14:39:26 2014 From: lsp at informatik.uni-kiel.de (lennart spitzner) Date: Fri, 14 Nov 2014 15:39:26 +0100 Subject: [Haskell-cafe] Correct implementation of ListT besides the pipes package? In-Reply-To: <838169A9-B72B-485E-AEF7-0F3875B3F5D9@gmail.com> References: <838169A9-B72B-485E-AEF7-0F3875B3F5D9@gmail.com> Message-ID: <5466141E.3090005@informatik.uni-kiel.de> On 14/11/14 12:30, Nicola Gigante wrote: > Is there any package that provides a correct ListT? list-t on hackage is an existing implementation (that corresponds to the "ListT done right alternative"). It is small/has only few dependencies. Lennart From kc1956 at gmail.com Fri Nov 14 16:01:25 2014 From: kc1956 at gmail.com (KC) Date: Fri, 14 Nov 2014 08:01:25 -0800 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <20141114135120.GE4785@weber> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <20141114095249.GD4785@weber> <7BA816A7-999F-4A85-BAB5-428AA6AF5BC6@gmail.com> <20141114135120.GE4785@weber> Message-ID: Are you compiling? Just recently I had someone complain that Haskell wouldn't handle large files but he was using the interpreter. After compiling his problem vanished. -- -- Sent from an expensive device which will be obsolete in a few months! :D Casey On Nov 14, 2014 5:54 AM, "Tom Ellis" < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Fri, Nov 14, 2014 at 09:14:17PM +0800, zhangjun.julian wrote: > > Dear Tom > > > > I change Map to Strict?it be little fast when test with 18M rows, but it > hanged again with 40M rows. > > > > Do you have any other advice? > > Dear Zhangjun Julian, > > Perhaps too much of the output string is being kept around when it is > printed. I would try > > mapM_ (\((x,y), i) -> hPutStrLn writeHadle (show x ++ "," ++ show y > ++ "," ++ show i)) > (DM.toList rt) > > instead of > > hPutStr writeHadle $ mapToString rt > > Apart from that, I don't have any other ideas. Can you determine whether > the large memory usage comes from the Pipe or from the printing of the > result? > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Fri Nov 14 16:47:16 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Fri, 14 Nov 2014 17:47:16 +0100 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> Message-ID: <54663214.5030405@power.com.pl> On 14.11.2014 10:43, zhangjun.julian wrote: > > emptyMap = DM.empty::(DM.Map (String,String) Int) > > Laziness makes your data swell. 1) Try using ByteString or Text instead of String. 2) Try the UNPACK pragma, AFAIR it requires -O2. data Key = Key {-# UNPACK #-} !ByteString {-# UNPACK #-} !ByteString https://hackage.haskell.org/package/ghc-datasize - this package will help you to determine the actual data size -- Wojtek -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Nov 14 17:31:59 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 14 Nov 2014 17:31:59 +0000 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <54663214.5030405@power.com.pl> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> Message-ID: <20141114173159.GF4785@weber> On Fri, Nov 14, 2014 at 05:47:16PM +0100, Wojtek Narczy?ski wrote: > On 14.11.2014 10:43, zhangjun.julian wrote: > >emptyMap = DM.empty::(DM.Map (String,String) Int) > > Laziness makes your data swell. > > 1) Try using ByteString or Text instead of String. > 2) Try the UNPACK pragma, AFAIR it requires -O2. > data Key = Key {-# UNPACK #-} !ByteString {-# UNPACK #-} !ByteString > https://hackage.haskell.org/package/ghc-datasize - this package > will help you to determine the actual data size This is certainly true, but there is a distinction to be drawn between "swollen data" that is a few times bigger than it could be, and a space leak. Zhangjun Julian's biggest problem is definitely the latter. There's no reason that compiling a dictionary counting occurences and printing it out should consume 9GB. Once the space leak is fixed your suggestions will help reduce memory usage further. Tom From cma at bitemyapp.com Fri Nov 14 18:13:26 2014 From: cma at bitemyapp.com (Chris Allen) Date: Fri, 14 Nov 2014 12:13:26 -0600 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> Message-ID: <1A6CF76D-04F7-4AA4-A473-1F4D7CE0DC83@bitemyapp.com> There is #numerical-Haskell on Freenode and an NLP mailing list I believe. Sent from my iPhone > On Nov 13, 2014, at 9:40 PM, Mark Fredrickson wrote: > > Is there a mailing list for statistics/analytics/simulation/numerical > analysis/etc. using Haskell? If not, I purpose we start one. (Not to > take away from general discussion, but to provide a forum to hash out > these issues among the primary user base). > > -M > > >> On Thu, Nov 13, 2014 at 12:46 PM, Tobias Pflug wrote: >> >> >> Big enough machine with enough memory and it's fine. I used to keep a job >> queue with a billion rows on MySQL at a gig long ago. Could do it with >> PostgreSQL pretty easily too. On your personal work machine? I dunno. >> >> Not trying to steer you away from using Haskell here by any means, but if >> you can process your data in a SQL database efficiently, that's often pretty >> optimal in terms of speed and ease of use until you start doing more >> sophisticated analysis. I don't have a lot of experience in data analysis >> but I knew people to do some preliminary slicing/dicing in SQL before moving >> onto a building a custom model for understanding the data. >> >> >> I guess I was just curious what a sensible approach using Haskell would look >> like and i'll play >> around with what I know now. If this was from my working place i'd just put >> it in a database with >> enough horse power but it's just my curiosity in my spare time, alas.. >> >> thank you for your input. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From hjgtuyl at chello.nl Fri Nov 14 19:15:11 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Fri, 14 Nov 2014 20:15:11 +0100 Subject: [Haskell-cafe] Programming videogames in haskell In-Reply-To: References: Message-ID: On Fri, 14 Nov 2014 10:26:40 +0100, Quentin Le Guennec wrote: > Hello, > > We're building a indie game studio with some friends. I am the lead > developper and i am planning to write the game logic and graphics in > haskell. I would like to know if some of you have some experience in game > developpement in haskell, functionnal reactive programming in particular. A good starting point would be: https://www.haskell.org/haskellwiki/Game_Development Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From wojtek at power.com.pl Fri Nov 14 19:54:31 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Fri, 14 Nov 2014 20:54:31 +0100 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <20141114173159.GF4785@weber> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> <20141114173159.GF4785@weber> Message-ID: <54665DF7.7070505@power.com.pl> On 14.11.2014 18:31, Tom Ellis wrote: > > Zhangjun Julian's biggest problem is definitely the latter. There's no > reason that compiling a dictionary counting occurences and printing it out > should consume 9GB. Once the space leak is fixed your suggestions will help > reduce memory usage further. > Right, I missed that the expected cardinality of the set is 10K. From wojtek at power.com.pl Fri Nov 14 20:01:38 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Fri, 14 Nov 2014 21:01:38 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: References: <5463E2D3.7040305@power.com.pl> Message-ID: <54665FA2.3030902@power.com.pl> On 13.11.2014 19:56, Evan Laforge wrote: > > WASH did that, a long time ago. They mentioned that they > intentionally relaxed the rules, since being totally correct was > annoying to actually use. There are docs here: > http://www2.informatik.uni-freiburg.de/~thiemann/WASH/ > Very nice package, I printed the paper, I'll look into it. I like renovating old Haskell (and Ada) software, it is always so little work. -- Wojtek From wojtek at power.com.pl Fri Nov 14 22:49:18 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Fri, 14 Nov 2014 23:49:18 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: <54647BD9.2090600@gmx.net> References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> Message-ID: <546686EE.6000701@power.com.pl> On 13.11.2014 10:37, Tobias Pflug wrote: > > data RadioStat = { > rStart :: Integer -- POSIX time stamp > , rStation :: Integer -- index to station map > , rDuration :: Integer -- duration in seconds > , rAgent :: Integer -- index to agent map > ("mobile", "desktop", ..) > , rCountry :: Integer -- index to country map > ("DE", "CH", ..) > , rArea :: Integer -- German geo location info > } Could you show a sampe record or two? It will be an interesting case to calculate now many bits of information there are vs. how many bits will Haskell need. -- Wojtek From zhangjun.julian at gmail.com Fri Nov 14 22:50:26 2014 From: zhangjun.julian at gmail.com (zhangjun.julian) Date: Sat, 15 Nov 2014 06:50:26 +0800 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <20141114173159.GF4785@weber> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> <20141114173159.GF4785@weber> Message-ID: <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> Dear Tom and others I?m sorry. I think I had made a mistake, I test Tom?s advice in my master branch not in the demo code. In the master branch I had a list file to read, so I use mapM_ to call rCount as blow mapM_ (\(x,y) -> rCount num readhandle1 x y) handlePairList If I change my Map to Strict and call rCount directly( don?t use mapM_ ) the memory will not swell. I can understand why lazy Map will cause swell, but I don?t know why mapM_ will cause swell? Does the mapM_ is lazy too? Any strict alternative I can use? > ? 2014?11?15????1:31?Tom Ellis ??? > > On Fri, Nov 14, 2014 at 05:47:16PM +0100, Wojtek Narczy?ski wrote: >> On 14.11.2014 10:43, zhangjun.julian wrote: >>> emptyMap = DM.empty::(DM.Map (String,String) Int) >> >> Laziness makes your data swell. >> >> 1) Try using ByteString or Text instead of String. >> 2) Try the UNPACK pragma, AFAIR it requires -O2. >> data Key = Key {-# UNPACK #-} !ByteString {-# UNPACK #-} !ByteString >> https://hackage.haskell.org/package/ghc-datasize - this package >> will help you to determine the actual data size > > This is certainly true, but there is a distinction to be drawn between > "swollen data" that is a few times bigger than it could be, and a space leak. > > Zhangjun Julian's biggest problem is definitely the latter. There's no > reason that compiling a dictionary counting occurences and printing it out > should consume 9GB. Once the space leak is fixed your suggestions will help > reduce memory usage further. > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Fri Nov 14 23:25:48 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Sat, 15 Nov 2014 00:25:48 +0100 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> <20141114173159.GF4785@weber> <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> Message-ID: <54668F7C.1020900@power.com.pl> On 14.11.2014 23:50, zhangjun.julian wrote: > If I change my Map to Strict and call rCount directly( don?t use > mapM_ ) the memory will not swell. > I used the word "swell" to describe the phenomenon that in Haskell pointers can consume vast amounts of memory, especially on 64 bit architectures. For example type (Bool,Bool,Bool,Bool,Bool,Bool,Bool,Bool), one byte of information, will take 136 bytes, unless you fight the laziness feature with ! and UNPACK. Okay, this is an evil contrived example, but you get the idea. It is not generally accepted nomenclature. You were hit by what is referred to as "space leak", that is build-up of unevaluated closures. Anyway, I'm glad to hear that your problem is gone. -- Kind reagards, Wojtek -------------- next part -------------- An HTML attachment was scrubbed... URL: From sean.seefried at gmail.com Sat Nov 15 01:25:47 2014 From: sean.seefried at gmail.com (sean.seefried at gmail.com) Date: Sat, 15 Nov 2014 12:25:47 +1100 Subject: [Haskell-cafe] Programming videogames in haskell Message-ID: <5466aba1.6b45440a.5a19.ffffa05b@mx.google.com> Hi Quentin, I am currently building a game in Haskell that I plan to deploy to iOS and Android. It?s built using a combination of SDL2 and Cairo (for vector graphics) and Hipmunk (for physics via the Chipmunk C library). As in Ivan Perez's case I?m not using the Hackage versions of the SDL2 bindings. Instead I?m using the versions found on Github at [1] and [2]. I have recently managed to deploy my game to Android but this has not been a straightforward process. Building a GHC cross compiler for ARM was a time consuming process but greatly aided by the using the script found in the stable-ghc-snapshot branch of joehy?s repo on Github [3]. Building all the libraries I needed was even less straightforward. (I?ve written more about this in a post script) Deploying to iOS should be a much more straightforward process since there is official GHC support for iOS and you can download a binary distribution of the cross compiler at [4]. (Scroll down to find Luke Iannini?s distribution. Luke Iannini, Steven Blackheath put in a lot of hard work over many months to provide iOS support for GHC.) I?ve also had a play around with Helm which uses the Elerea FRP library, SDL2 and Cairo. I think it?s a pretty good little library for prototyping, although you will need to learn FRP (Functional Reactive Programming) in the process. Cheers, Sean p.s. Here is a little more detail on targeting ARM. Many of the libraries, notably the SDL2 binding, did not work out of the box with a cross compiler since they did not use Cabal?s Distribution.Simple and required that Setup.hs was compiled and run. Unfortunately this just does not work with a cross-compiler since you can?t run the code on your host machine. The work around is to build it using GHC targeting the host machine and to run that. This works okay, but a straight ?cabal install? will not. A more serious problem I ran into was that the SDL2 binding requires the use of hsc2c. hsc2c has a --cross-compile flag but it does not support all of the hsc2c directives, specifically the ?let? directive which is used by SDL2. [1] https://github.com/Lemmih/hsSDL2 [2] https://github.com/jdeseno/hs-sdl2-mixer [3] https://github.com/joeyh/ghc-android [4] https://www.haskell.org/ghc/download_ghc_7_8_3 -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominic at steinitz.org Sat Nov 15 06:54:38 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Sat, 15 Nov 2014 06:54:38 +0000 (UTC) Subject: [Haskell-cafe] data analysis question References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> Message-ID: Mark Fredrickson gmail.com> writes: > > Is there a mailing list for statistics/analytics/simulation/numerical > analysis/etc. using Haskell? If not, I purpose we start one. (Not to > take away from general discussion, but to provide a forum to hash out > these issues among the primary user base). Sadly not but I think there are sufficient numbers of people interested in this subject that it is probably worth setting one up. I really don't like the google group experience but maybe that is the best place to start? From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Nov 16 09:47:29 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 16 Nov 2014 09:47:29 +0000 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> <20141114173159.GF4785@weber> <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> Message-ID: <20141116094729.GH4785@weber> On Sat, Nov 15, 2014 at 06:50:26AM +0800, zhangjun.julian wrote: > In the master branch I had a list file to read, so I use mapM_ to call rCount as blow > > mapM_ (\(x,y) -> rCount num readhandle1 x y) handlePairList > > If I change my Map to Strict and call rCount directly( don?t use mapM_ ) the memory will not swell. > > I can understand why lazy Map will cause swell, but I don?t know why mapM_ will cause swell? > Does the mapM_ is lazy too? > Any strict alternative I can use? I think you need to provide us with more details about exactly what this mapM_ is doing. From zhangjun.julian at gmail.com Sun Nov 16 09:55:42 2014 From: zhangjun.julian at gmail.com (zhangjun.julian) Date: Sun, 16 Nov 2014 17:55:42 +0800 Subject: [Haskell-cafe] How can I improve the pipes's performance with a huge file? In-Reply-To: <20141116094729.GH4785@weber> References: <40927136-540D-483B-81AE-96B67CDE5E1F@gmail.com> <54663214.5030405@power.com.pl> <20141114173159.GF4785@weber> <1B494E93-7301-4A31-8D33-44BE021F34BD@gmail.com> <20141116094729.GH4785@weber> Message-ID: Dear Tom and others I had fix the problem, with change code by 1, Change List to Sequence 2, Change mapM_ to Data.Traversable.sequence $ Sequence.map Thanks for you help > ? 2014?11?16????5:47?Tom Ellis ??? > > On Sat, Nov 15, 2014 at 06:50:26AM +0800, zhangjun.julian wrote: >> In the master branch I had a list file to read, so I use mapM_ to call rCount as blow >> >> mapM_ (\(x,y) -> rCount num readhandle1 x y) handlePairList >> >> If I change my Map to Strict and call rCount directly( don?t use mapM_ ) the memory will not swell. >> >> I can understand why lazy Map will cause swell, but I don?t know why mapM_ will cause swell? >> Does the mapM_ is lazy too? >> Any strict alternative I can use? > > I think you need to provide us with more details about exactly what this > mapM_ is doing. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From ben.franksen at online.de Sun Nov 16 13:42:28 2014 From: ben.franksen at online.de (Ben Franksen) Date: Sun, 16 Nov 2014 14:42:28 +0100 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments Message-ID: I have a question about how to reverse the text encoding as done by ghc and the base library for stuff that comes from the command line or the environment. Assume the user's environment specifies a non-Unicode locale, e.g. some latin encoding. In this case, the String we get from e.g. System.Environment.getArgs does *not* contain the Unicode code points of the characters the user has entered. Instead the input bytes are mapped one-to- one to Char. This has probably been done for compatibility reasons, and I do not want to discuss this choice here. Rather, I want to find out how I can convert such a string back to some proper Unicode representation, for instance in order to store the value in a file with a defined encoding such as utf-8. This should be done in a generic way, i.e. without making ad-hoc assumptions about what the user's encoding might be. There is the iconv package. However, it takes ByteString as input and output and it also requires that I give it the encoding as input. How do I find out which is this encoding? On the command line I could simply do ben at sarun[1]: ~ > locale charmap ISO-8859-1 Is there a Haskell function that does the equivalent or do I have to use getEnv "LC_CTYPE", then parse the result? Let's assume I get this to work, so now I have a String that represents the user's encoding, such as "ISO-8859-1". Now, in order to use iconv, I have to convert the string I got via getArgs into a ByteString. But to do that properly, I would have to decode it according to the user's current locale, which is exactly what I want to achieve in the first place. How do I break this cycle? Perhaps it is simpler to write our own getArgs/getEnv functions and directly convert the data we get from the system to a proper (Unicode) String? Any suggestions would be highly appreciated. Cheers Ben -- "Make it so they have to reboot after every typo." -- Scott Adams From dominic at steinitz.org Sun Nov 16 14:06:55 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Sun, 16 Nov 2014 14:06:55 +0000 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> Message-ID: <27F72B76-A0E1-406D-8D37-B141DC5B011D@steinitz.org> I?d much prefer that. I really dislike the google group experience. I?ll drop Austin a note. Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com On 15 Nov 2014, at 15:42, Ben Gamari wrote: > On November 15, 2014 1:54:38 AM EST, Dominic Steinitz wrote: >> Mark Fredrickson gmail.com> writes: >> >>> >>> Is there a mailing list for statistics/analytics/simulation/numerical >>> analysis/etc. using Haskell? If not, I purpose we start one. (Not to >>> take away from general discussion, but to provide a forum to hash out >>> these issues among the primary user base). >> >> Sadly not but I think there are sufficient numbers of people >> interested in this subject that it is probably worth setting one up. I >> really don't like the google group experience but maybe that is the >> best place to start? >> > I agree that this would be a worthwhile forum to have. Why not just stay with Haskell.org infrastructure? I'm sure Austin would set up a mailing list for the cause. > > Cheers, > > - Ben > > > From chowells79 at gmail.com Sun Nov 16 18:38:00 2014 From: chowells79 at gmail.com (Carl Howells) Date: Sun, 16 Nov 2014 10:38:00 -0800 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments In-Reply-To: References: Message-ID: If the input bytes are mapped 1-1 to Char values without conversion, you can just use Data.ByteString.Char8.pack to convert to a ByteString, which you can then convert to Unicode however you like. On Sun, Nov 16, 2014 at 5:42 AM, Ben Franksen wrote: > I have a question about how to reverse the text encoding as done by ghc and > the base library for stuff that comes from the command line or the > environment. > > Assume the user's environment specifies a non-Unicode locale, e.g. some > latin encoding. In this case, the String we get from e.g. > System.Environment.getArgs does *not* contain the Unicode code points of the > characters the user has entered. Instead the input bytes are mapped one-to- > one to Char. This has probably been done for compatibility reasons, and I do > not want to discuss this choice here. Rather, I want to find out how I can > convert such a string back to some proper Unicode representation, for > instance in order to store the value in a file with a defined encoding such > as utf-8. > > This should be done in a generic way, i.e. without making ad-hoc assumptions > about what the user's encoding might be. > > There is the iconv package. However, it takes ByteString as input and output > and it also requires that I give it the encoding as input. How do I find out > which is this encoding? On the command line I could simply do > > ben at sarun[1]: ~ > locale charmap > ISO-8859-1 > > Is there a Haskell function that does the equivalent or do I have to use > getEnv "LC_CTYPE", then parse the result? > > Let's assume I get this to work, so now I have a String that represents the > user's encoding, such as "ISO-8859-1". Now, in order to use iconv, I have to > convert the string I got via getArgs into a ByteString. But to do that > properly, I would have to decode it according to the user's current locale, > which is exactly what I want to achieve in the first place. > > How do I break this cycle? > > Perhaps it is simpler to write our own getArgs/getEnv functions and directly > convert the data we get from the system to a proper (Unicode) String? > > Any suggestions would be highly appreciated. > > Cheers > Ben > -- > "Make it so they have to reboot after every typo." -- Scott Adams > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From allbery.b at gmail.com Sun Nov 16 18:42:28 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Sun, 16 Nov 2014 13:42:28 -0500 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments In-Reply-To: References: Message-ID: On Sun, Nov 16, 2014 at 8:42 AM, Ben Franksen wrote: > How do I break this cycle? > > Perhaps it is simpler to write our own getArgs/getEnv functions and > directly > convert the data we get from the system to a proper (Unicode) String? > Ideally there should be a System.Posix.Environment.getArgs that just returns the raw POSIX string (possibly as a ByteString); as with most of POSIX, there is no defined encoding for this, it's octets. If you insist on imposing an encoding on it, you could start from that. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From donn at avvanta.com Sun Nov 16 18:46:44 2014 From: donn at avvanta.com (Donn Cave) Date: Sun, 16 Nov 2014 10:46:44 -0800 (PST) Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments In-Reply-To: References: Message-ID: <20141116184644.97970276CB6@mail.avvanta.com> quoth Ben Franksen ... > Perhaps it is simpler to write our own getArgs/getEnv functions and directly > convert the data we get from the system to a proper (Unicode) String? I may be confused here - trying this out, I seem to be getting garbage I don't understand from System.Environment getArgs. But there's a System.Posix.Env.ByteString getArgs, that looks like just what you propose above. import qualified Data.ByteString.Char8 as P import qualified System.Posix.Env.ByteString as B import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) argsb <- B.getArgs putStrLn ("byte args: " ++ show(argsb)) let argsu = map (encodeUtf8 . T.pack . P.unpack) argsb putStrLn ("UTF8 byte args: " ++ show(argsu)) $ ./cvtargs [string that perhaps should not be in this email!] byte args: ["S\228kkij\228rven","Polkka"] UTF8 byte args: ["S\195\164kkij\195\164rven","Polkka"] Donn From ben.franksen at online.de Sun Nov 16 19:01:24 2014 From: ben.franksen at online.de (Ben Franksen) Date: Sun, 16 Nov 2014 20:01:24 +0100 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments References: Message-ID: Carl Howells wrote: > If the input bytes are mapped 1-1 to Char values without conversion, > you can just use Data.ByteString.Char8.pack to convert to a > ByteString, which you can then convert to Unicode however you like. Yes, but I cannot be sure this is the case, it depends on the user's locale encoding. Cheers Ben > On Sun, Nov 16, 2014 at 5:42 AM, Ben Franksen > wrote: >> I have a question about how to reverse the text encoding as done by ghc >> and the base library for stuff that comes from the command line or the >> environment. >> >> Assume the user's environment specifies a non-Unicode locale, e.g. some >> latin encoding. In this case, the String we get from e.g. >> System.Environment.getArgs does *not* contain the Unicode code points of >> the characters the user has entered. Instead the input bytes are mapped >> one-to- one to Char. This has probably been done for compatibility >> reasons, and I do not want to discuss this choice here. Rather, I want to >> find out how I can convert such a string back to some proper Unicode >> representation, for instance in order to store the value in a file with a >> defined encoding such as utf-8. >> >> This should be done in a generic way, i.e. without making ad-hoc >> assumptions about what the user's encoding might be. >> >> There is the iconv package. However, it takes ByteString as input and >> output and it also requires that I give it the encoding as input. How do >> I find out which is this encoding? On the command line I could simply do >> >> ben at sarun[1]: ~ > locale charmap >> ISO-8859-1 >> >> Is there a Haskell function that does the equivalent or do I have to use >> getEnv "LC_CTYPE", then parse the result? >> >> Let's assume I get this to work, so now I have a String that represents >> the user's encoding, such as "ISO-8859-1". Now, in order to use iconv, I >> have to convert the string I got via getArgs into a ByteString. But to do >> that properly, I would have to decode it according to the user's current >> locale, which is exactly what I want to achieve in the first place. >> >> How do I break this cycle? >> >> Perhaps it is simpler to write our own getArgs/getEnv functions and >> directly convert the data we get from the system to a proper (Unicode) >> String? >> >> Any suggestions would be highly appreciated. >> >> Cheers >> Ben >> -- >> "Make it so they have to reboot after every typo." -- Scott Adams >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe -- "Make it so they have to reboot after every typo." -- Scott Adams From ben.franksen at online.de Sun Nov 16 19:32:08 2014 From: ben.franksen at online.de (Ben Franksen) Date: Sun, 16 Nov 2014 20:32:08 +0100 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments References: <20141116184644.97970276CB6@mail.avvanta.com> Message-ID: Donn Cave wrote: > quoth Ben Franksen > ... >> Perhaps it is simpler to write our own getArgs/getEnv functions and >> directly convert the data we get from the system to a proper (Unicode) >> String? > > I may be confused here - trying this out, I seem to be getting > garbage I don't understand from System.Environment getArgs. > > But there's a System.Posix.Env.ByteString getArgs, that looks like > just what you propose above. > > import qualified Data.ByteString.Char8 as P > import qualified System.Posix.Env.ByteString as B > import qualified Data.Text as T > import Data.Text.Encoding (decodeUtf8, encodeUtf8) > > argsb <- B.getArgs > putStrLn ("byte args: " ++ show(argsb)) > let argsu = map (encodeUtf8 . T.pack . P.unpack) argsb > putStrLn ("UTF8 byte args: " ++ show(argsu)) > > $ ./cvtargs [string that perhaps should not be in this email!] > byte args: ["S\228kkij\228rven","Polkka"] > UTF8 byte args: ["S\195\164kkij\195\164rven","Polkka"] Cool, I wasn't aware that System.Posix had that function. Now I need to see what to do for Windows... Anyway, many thanks to you and everyone else who offered suggestions. Cheers Ben -- "Make it so they have to reboot after every typo." -- Scott Adams From codygman.consulting at gmail.com Sun Nov 16 21:08:17 2014 From: codygman.consulting at gmail.com (Cody Goodman) Date: Sun, 16 Nov 2014 15:08:17 -0600 Subject: [Haskell-cafe] Using wreq Session handling in a monad transformer stack Message-ID: Could I somehow add a Wreq.Session.Session to my monad transformer stack? Should I use something other than Wreq? How would I create a default Session, Wreq doesn't seem to export the constructor. Basically I want to achieve Sessions/cookie handling. lpaste of my code: http://lpaste.net/114405 my full code (for those who want to view in email): {-# LANGUAGE OverloadedStrings #-} module Network.Scraper.State where import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class (liftIO) import qualified Control.Monad.Trans.State.Strict as ST import qualified Data.ByteString.Lazy as LBS import Data.Maybe (fromJust, fromMaybe) import Data.Monoid import qualified Data.Text as T import qualified Data.Text.IO as TIO import Network.Wreq (FormParam (..)) import qualified Network.Wreq as Wreq import Network.Wreq.Session (Session (..), withSession) import qualified Network.Wreq.Session as Sesh import Network.Wreq.Types import Safe import Text.HTML.DOM (parseLBS) import Text.XML.Cursor import qualified Text.XML.Cursor.Generic as CG data ScraperState = PS { currentOptions :: Wreq.Options , currentHtml :: LBS.ByteString , currentCursor :: Maybe Cursor , currentSession :: Session } deriving (Show) type Scraper = ST.StateT ScraperState IO toCursor = fromDocument . parseLBS initialSt = PS { currentOptions = Wreq.defaults , currentHtml = ("" :: LBS.ByteString) , currentCursor = Nothing -- , currentSession = ... how do I get a Session? Wreq doesn't seem to export this type } setCurrentOptions :: Wreq.Options -> Scraper () setCurrentOptions o = do scraper <- ST.get ST.put $ scraper { currentOptions = o } -- getCurrentPage :: Shpider Page getCurrentCursor :: Scraper (Maybe Cursor) getCurrentCursor = do scraper <- ST.get return $ currentCursor scraper getCurrentSession :: Scraper (Session) getCurrentSession = do scraper <- ST.get return $ currentSession scraper setCurrentSession :: Session -> Scraper () setCurrentSession s = do scraper <- ST.get ST.put $ scraper { currentSession = s} setCurrentCursor :: Cursor -> Scraper ( ) setCurrentCursor c = do scraper <- ST.get ST.put $ scraper { currentCursor = Just c } setCurrentHtml :: LBS.ByteString -> Scraper () setCurrentHtml html = do scraper <- ST.get ST.put $ scraper { currentHtml = html } runScraper :: Scraper a -> IO a runScraper k = evalScraperWith k initialSt evalScraperWith :: Scraper a -> ScraperState -> IO a evalScraperWith k s = withSession $ \sesh -> do -- set the current session to the mutable session variable return $ setCurrentSession sesh ST.evalStateT k s formShortInfo' f = formInfo' where go Nothing = "N/A" go (Just x) = x formInfo = (headMay . attribute "name" $ f, headMay . attribute "action" $ f) formInfo' = (\(x,y) -> (go x, go y)) formInfo ppTuple :: (T.Text, T.Text) -> T.Text ppTuple = \(x,y) -> "[" <> x <> "]" <> ": " <> y -- move to ../Spider.hs printFormNames :: Scraper () printFormNames = do c <- getCurrentCursor let c' = fromMaybe (error "No cursor set") c forms = c' $// element "form" formInfo = map (ppTuple . formShortInfo') forms liftIO $ mapM_ (TIO.putStrLn) formInfo getFormByName :: T.Text -> Scraper [Cursor] getFormByName name = do c <- getCurrentCursor let c' = fromMaybe (error "No cursor set") c return $ c' $// element "form" >=> attributeIs "name" name get :: String -> Scraper (LBS.ByteString) get url = do r <- liftIO $ Wreq.get url let html = r ^. Wreq.responseBody setCurrentHtml html setCurrentCursor (toCursor html) return html post :: Postable a => String -> a -> Scraper (LBS.ByteString) post url params = do r <- liftIO $ Wreq.post url params let html = r ^. Wreq.responseBody setCurrentHtml html setCurrentCursor (toCursor html) return html test :: Scraper () test = do get "https://www.google.com" >> printFormNames From lambda.fairy at gmail.com Sun Nov 16 22:07:30 2014 From: lambda.fairy at gmail.com (Chris Wong) Date: Mon, 17 Nov 2014 11:07:30 +1300 Subject: [Haskell-cafe] Using wreq Session handling in a monad transformer stack In-Reply-To: References: Message-ID: Hi Cody, I don't use wreq myself, but withSession [1] is probably what you want. Here's an example: withInitialState :: (ScraperState -> IO a) -> IO a withInitialState callback = withSession $ \session -> let initialState = PS { -- ... other options here ... currentSession = session } in callback initialState [1] http://hackage.haskell.org/package/wreq-0.2.0.0/docs/Network-Wreq-Session.html On Mon, Nov 17, 2014 at 10:08 AM, Cody Goodman wrote: > Could I somehow add a Wreq.Session.Session to my monad transformer > stack? Should I use something other than Wreq? How would I create a > default Session, Wreq doesn't seem to export the constructor. > Basically I want to achieve Sessions/cookie handling. > > lpaste of my code: > http://lpaste.net/114405 > > > my full code (for those who want to view in email): > > {-# LANGUAGE OverloadedStrings #-} > module Network.Scraper.State where > > import Control.Lens ((^.)) > import Control.Monad > import Control.Monad.IO.Class (liftIO) > import qualified Control.Monad.Trans.State.Strict as ST > import qualified Data.ByteString.Lazy as LBS > import Data.Maybe (fromJust, fromMaybe) > import Data.Monoid > import qualified Data.Text as T > import qualified Data.Text.IO as TIO > import Network.Wreq (FormParam (..)) > import qualified Network.Wreq as Wreq > import Network.Wreq.Session (Session (..), withSession) > import qualified Network.Wreq.Session as Sesh > import Network.Wreq.Types > import Safe > import Text.HTML.DOM (parseLBS) > import Text.XML.Cursor > import qualified Text.XML.Cursor.Generic as CG > > > data ScraperState = > PS { currentOptions :: Wreq.Options > , currentHtml :: LBS.ByteString > , currentCursor :: Maybe Cursor > , currentSession :: Session > } deriving (Show) > > type Scraper = ST.StateT ScraperState IO > > toCursor = fromDocument . parseLBS > > initialSt = > PS { currentOptions = Wreq.defaults > , currentHtml = ("" :: LBS.ByteString) > , currentCursor = Nothing > -- , currentSession = ... how do I get a Session? Wreq doesn't > seem to export this type > } > > setCurrentOptions :: Wreq.Options -> Scraper () > setCurrentOptions o = do > scraper <- ST.get > ST.put $ scraper { currentOptions = o } > > -- getCurrentPage :: Shpider Page > getCurrentCursor :: Scraper (Maybe Cursor) > getCurrentCursor = do > scraper <- ST.get > return $ currentCursor scraper > > getCurrentSession :: Scraper (Session) > getCurrentSession = do > scraper <- ST.get > return $ currentSession scraper > > setCurrentSession :: Session -> Scraper () > setCurrentSession s = do > scraper <- ST.get > ST.put $ scraper { currentSession = s} > > setCurrentCursor :: Cursor -> Scraper ( ) > setCurrentCursor c = do > scraper <- ST.get > ST.put $ scraper { currentCursor = Just c } > > setCurrentHtml :: LBS.ByteString -> Scraper () > setCurrentHtml html = do > scraper <- ST.get > ST.put $ scraper { currentHtml = html } > > runScraper :: Scraper a -> IO a > runScraper k = evalScraperWith k initialSt > > evalScraperWith :: Scraper a -> ScraperState -> IO a > evalScraperWith k s = withSession $ \sesh -> do > -- set the current session to the mutable session variable > return $ setCurrentSession sesh > ST.evalStateT k s > > formShortInfo' f = formInfo' > where > go Nothing = "N/A" > go (Just x) = x > formInfo = (headMay . attribute "name" $ f, headMay . attribute > "action" $ f) > formInfo' = (\(x,y) -> (go x, go y)) formInfo > > ppTuple :: (T.Text, T.Text) -> T.Text > ppTuple = \(x,y) -> "[" <> x <> "]" <> ": " <> y > > -- move to ../Spider.hs > printFormNames :: Scraper () > printFormNames = do > c <- getCurrentCursor > let c' = fromMaybe (error "No cursor set") c > forms = c' $// element "form" > formInfo = map (ppTuple . formShortInfo') forms > liftIO $ mapM_ (TIO.putStrLn) formInfo > > getFormByName :: T.Text -> Scraper [Cursor] > getFormByName name = do > c <- getCurrentCursor > let c' = fromMaybe (error "No cursor set") c > return $ c' $// element "form" >=> attributeIs "name" name > > get :: String -> Scraper (LBS.ByteString) > get url = do > r <- liftIO $ Wreq.get url > let html = r ^. Wreq.responseBody > setCurrentHtml html > setCurrentCursor (toCursor html) > return html > > post :: Postable a => String -> a -> Scraper (LBS.ByteString) > post url params = do > r <- liftIO $ Wreq.post url params > let html = r ^. Wreq.responseBody > setCurrentHtml html > setCurrentCursor (toCursor html) > return html > > test :: Scraper () > test = do > get "https://www.google.com" >> printFormNames > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -- https://lambda.xyz From gershomb at gmail.com Sun Nov 16 23:44:20 2014 From: gershomb at gmail.com (Gershom B) Date: Sun, 16 Nov 2014 18:44:20 -0500 Subject: [Haskell-cafe] Call for Presentations: Compose Conference [New York, Jan 30-Feb 1] Message-ID: Compose is a new conference for typed functional programmers, focused specifically on Haskell, OCaml, F#, and related technologies. It will be held in New York from Jan 30-Feb 1, and registration is opening shortly.? http://www.composeconference.org/ Below is our call for presentations. We recognize the deadline is tight, so feel free to submit proposals and ideas on the less-polished side. Call for Presentations and Speakers. http://www.composeconference.org/call/index.html --- The audience for Compose is Haskell, OCaml, or F# developers who are looking to increase their skills or learn new technologies and libraries. Presentations should be aimed at teaching or introducing new ideas or tools. We are also interested in presentations aiming at taking complex concepts, such as program derivation, and putting them into productive use. However proposals on anything that you suspect our audience may find interesting are welcome. The following are some of the types of talks we would welcome: Library/Tool Talks ? Exploring the uses of a powerful toolkit or library, be it for parsing, testing, data access and analysis, or anything else. Production Systems ? Experience reports on deploying functional techniques in real systems; insights revealed, mistakes made, lessons learned. Theory made Practical ? Just because it?s locked away in papers doesn?t mean it?s hard! Accessible lectures on classic results and why they matter to us today. Such talks can include simply introducing the principles of a field of research so as to help the audience read up on it in the future; from abstract machines to program derivation to branch-and-bound algorithms, the sky?s the limit. We also welcome proposals for more formal tutorials for the Sunday unconference. Such tutorials should be aimed at a smaller audience of beginner-to-novice understanding, and ideally include hands-on exercises. The due date for submissions is November 30, 2014. We will send out notice of acceptance by 10 December. We prefer that submissions be via the EasyChair website (https://easychair.org/conferences/?conf=compose2015). Please suggest a title, and describe the topic you intend to speak on. Additional information may be included on both your expertise and the interesting elements of your topic, going on what might be included in a public abstract. Furthermore, if your abstract doesn't feel "final"?don't worry! We'll work with you to polish it up. If you want to discuss your proposal(s) before submitting, or to further nail down what you intend to speak on, please feel free to contact us at info at composeconference.org. We're happy to work with you, even if you are a new or inexperienced speaker, to help your talk be great. ?Gershom From mihai.maruseac at gmail.com Mon Nov 17 02:02:38 2014 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Sun, 16 Nov 2014 21:02:38 -0500 Subject: [Haskell-cafe] [Haskell] ANNOUNCE: Haskell Communities and Activities Report (27th ed., November 2014) Message-ID: On behalf of all the contributors, we are pleased to announce that the Haskell Communities and Activities Report (27th edition, November 2014) is now available, in PDF and HTML formats: http://haskell.org/communities/11-2014/report.pdf http://haskell.org/communities/11-2014/html/report.html Many thanks go to all the people that contributed to this report, both directly, by sending in descriptions, and indirectly, by doing all the interesting things that are reported. We hope you will find it as interesting a read as we did. If you have not encountered the Haskell Communities and Activities Reports before, you may like to know that the first of these reports was published in November 2001. Their goal is to improve the communication between the increasingly diverse groups, projects, and individuals working on, with, or inspired by Haskell. The idea behind these reports is simple: Every six months, a call goes out to all of you enjoying Haskell to contribute brief summaries of your own area of work. Many of you respond (eagerly, unprompted, and sometimes in time for the actual deadline) to the call. The editors collect all the contributions into a single report and feed that back to the community. When we try for the next update, six months from now, you might want to report on your own work, project, research area or group as well. So, please put the following into your diaries now: ======================================== End of April 2015: target deadline for contributions to the May 2015 edition of the HC&A Report ======================================== Unfortunately, many Haskellers working on interesting projects are so busy with their work that they seem to have lost the time to follow the Haskell related mailing lists and newsgroups, and have trouble even finding time to report on their work. If you are a member, user or friend of a project so burdened, please find someone willing to make time to report and ask them to "register" with the editors for a simple e-mail reminder in October (you could point us to them as well, and we can then politely ask if they want to contribute, but it might work better if you do the initial asking). Of course, they will still have to find the ten to fifteen minutes to draw up their report, but maybe we can increase our coverage of all that is going on in the community. Feel free to circulate this announcement further in order to reach people who might otherwise not see it. Enjoy! Mihai Maruseac and Alejandro Serrano Mena -- Mihai Maruseac (MM) "If you don't know, the thing to do is not to get scared, but to learn." -- Atlas Shrugged. From alpmestan at gmail.com Mon Nov 17 02:51:14 2014 From: alpmestan at gmail.com (Alp Mestanogullari) Date: Mon, 17 Nov 2014 03:51:14 +0100 Subject: [Haskell-cafe] data analysis question In-Reply-To: <27F72B76-A0E1-406D-8D37-B141DC5B011D@steinitz.org> References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> <27F72B76-A0E1-406D-8D37-B141DC5B011D@steinitz.org> Message-ID: +1 for the mailing list suggestion. In addition to the obvious reasons why this would be a good idea, this would also let us coordinate efforts in the numerical computing / AI space to get a somewhat compatible/consistent ecosystem. On Sun, Nov 16, 2014 at 3:06 PM, Dominic Steinitz wrote: > I?d much prefer that. I really dislike the google group experience. I?ll > drop Austin a note. > > Dominic Steinitz > dominic at steinitz.org > http://idontgetoutmuch.wordpress.com > > On 15 Nov 2014, at 15:42, Ben Gamari wrote: > > > On November 15, 2014 1:54:38 AM EST, Dominic Steinitz < > dominic at steinitz.org> wrote: > >> Mark Fredrickson gmail.com> writes: > >> > >>> > >>> Is there a mailing list for statistics/analytics/simulation/numerical > >>> analysis/etc. using Haskell? If not, I purpose we start one. (Not to > >>> take away from general discussion, but to provide a forum to hash out > >>> these issues among the primary user base). > >> > >> Sadly not but I think there are sufficient numbers of people > >> interested in this subject that it is probably worth setting one up. I > >> really don't like the google group experience but maybe that is the > >> best place to start? > >> > > I agree that this would be a worthwhile forum to have. Why not just stay > with Haskell.org infrastructure? I'm sure Austin would set up a mailing > list for the cause. > > > > Cheers, > > > > - Ben > > > > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- Alp Mestanogullari -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Mon Nov 17 04:49:38 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 16 Nov 2014 23:49:38 -0500 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> <27F72B76-A0E1-406D-8D37-B141DC5B011D@steinitz.org> Message-ID: https://groups.google.com/forum/#!forum/numericalhaskell On Sun, Nov 16, 2014 at 9:51 PM, Alp Mestanogullari wrote: > +1 for the mailing list suggestion. In addition to the obvious reasons why > this would be a good idea, this would also let us coordinate efforts in the > numerical computing / AI space to get a somewhat compatible/consistent > ecosystem. > > On Sun, Nov 16, 2014 at 3:06 PM, Dominic Steinitz > wrote: > >> I?d much prefer that. I really dislike the google group experience. I?ll >> drop Austin a note. >> >> Dominic Steinitz >> dominic at steinitz.org >> http://idontgetoutmuch.wordpress.com >> >> On 15 Nov 2014, at 15:42, Ben Gamari wrote: >> >> > On November 15, 2014 1:54:38 AM EST, Dominic Steinitz < >> dominic at steinitz.org> wrote: >> >> Mark Fredrickson gmail.com> writes: >> >> >> >>> >> >>> Is there a mailing list for statistics/analytics/simulation/numerical >> >>> analysis/etc. using Haskell? If not, I purpose we start one. (Not to >> >>> take away from general discussion, but to provide a forum to hash out >> >>> these issues among the primary user base). >> >> >> >> Sadly not but I think there are sufficient numbers of people >> >> interested in this subject that it is probably worth setting one up. I >> >> really don't like the google group experience but maybe that is the >> >> best place to start? >> >> >> > I agree that this would be a worthwhile forum to have. Why not just >> stay with Haskell.org infrastructure? I'm sure Austin would set up a >> mailing list for the cause. >> > >> > Cheers, >> > >> > - Ben >> > >> > >> > >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > > -- > Alp Mestanogullari > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Mon Nov 17 04:50:07 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 16 Nov 2014 23:50:07 -0500 Subject: [Haskell-cafe] data analysis question In-Reply-To: References: <54632C2B.6000803@gmx.net> <54647BD9.2090600@gmx.net> <5464FC80.8090608@gmx.net> <27F72B76-A0E1-406D-8D37-B141DC5B011D@steinitz.org> Message-ID: https://groups.google.com/forum/#!forum/numericalhaskell has ~20 members already, use it :) On Sun, Nov 16, 2014 at 11:49 PM, Carter Schonwald < carter.schonwald at gmail.com> wrote: > https://groups.google.com/forum/#!forum/numericalhaskell > > On Sun, Nov 16, 2014 at 9:51 PM, Alp Mestanogullari > wrote: > >> +1 for the mailing list suggestion. In addition to the obvious reasons >> why this would be a good idea, this would also let us coordinate efforts in >> the numerical computing / AI space to get a somewhat compatible/consistent >> ecosystem. >> >> On Sun, Nov 16, 2014 at 3:06 PM, Dominic Steinitz >> wrote: >> >>> I?d much prefer that. I really dislike the google group experience. I?ll >>> drop Austin a note. >>> >>> Dominic Steinitz >>> dominic at steinitz.org >>> http://idontgetoutmuch.wordpress.com >>> >>> On 15 Nov 2014, at 15:42, Ben Gamari wrote: >>> >>> > On November 15, 2014 1:54:38 AM EST, Dominic Steinitz < >>> dominic at steinitz.org> wrote: >>> >> Mark Fredrickson gmail.com> writes: >>> >> >>> >>> >>> >>> Is there a mailing list for statistics/analytics/simulation/numerical >>> >>> analysis/etc. using Haskell? If not, I purpose we start one. (Not to >>> >>> take away from general discussion, but to provide a forum to hash out >>> >>> these issues among the primary user base). >>> >> >>> >> Sadly not but I think there are sufficient numbers of people >>> >> interested in this subject that it is probably worth setting one up. I >>> >> really don't like the google group experience but maybe that is the >>> >> best place to start? >>> >> >>> > I agree that this would be a worthwhile forum to have. Why not just >>> stay with Haskell.org infrastructure? I'm sure Austin would set up a >>> mailing list for the cause. >>> > >>> > Cheers, >>> > >>> > - Ben >>> > >>> > >>> > >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >> >> >> >> -- >> Alp Mestanogullari >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From codygman.consulting at gmail.com Mon Nov 17 04:53:39 2014 From: codygman.consulting at gmail.com (Cody Goodman) Date: Sun, 16 Nov 2014 22:53:39 -0600 Subject: [Haskell-cafe] Using wreq Session handling in a monad transformer stack In-Reply-To: References: Message-ID: withSession doesn't seem to persist anything with this implementation: withInitialState :: (ScraperState -> IO a) -> IO a withInitialState callback = withSession $ \s -> do let initialState = PS { currentOptions = Wreq.defaults , currentHtml = ("" :: LBS.ByteString) , currentCursor = Nothing , currentSession = s } callback initialState runScraper :: Scraper a -> IO a runScraper k = withInitialState (evalScraperWith k) evalScraperWith :: Scraper a -> ScraperState -> IO a evalScraperWith k s = ST.evalStateT k s I looked up the source to withSession, since I don't get why this isn't working. withSession :: (Session -> IO a) -> IO a withSession act = do mv <- newMVar $ HTTP.createCookieJar [] HTTP.withManager defaultManagerSettings $ \mgr -> act Session { seshCookies = mv, seshManager = mgr } http://hackage.haskell.org/package/wreq-0.2.0.0/docs/src/Network-Wreq-Session.html#withSession I did however notice an addition added a few days ago, maybe this is what I need? withSessionWith :: HTTP.ManagerSettings -> (Session -> IO a) -> IO a withSessionWith settings act = do mv <- newMVar $ HTTP.createCookieJar [] HTTP.withManager settings $ \mgr -> act Session { seshCookies = mv , seshManager = mgr , seshRun = runWith } runWith :: Session -> Run Body -> Run Body runWith Session{..} act (Req _ req) = modifyMVar seshCookies $ \cj -> do resp <- act (Req (Right seshManager) (req & Lens.cookieJar ?~ cj)) return (resp ^. Wreq.responseCookieJar, resp) https://github.com/bos/wreq/blob/master/Network/Wreq/Session.hs#L42 On Sun, Nov 16, 2014 at 4:07 PM, Chris Wong wrote: > Hi Cody, > > I don't use wreq myself, but withSession [1] is probably what you want. > > Here's an example: > > withInitialState :: (ScraperState -> IO a) -> IO a > withInitialState callback = withSession $ \session -> > let initialState = PS { > -- ... other options here ... > currentSession = session > } > in callback initialState > > [1] http://hackage.haskell.org/package/wreq-0.2.0.0/docs/Network-Wreq-Session.html > > On Mon, Nov 17, 2014 at 10:08 AM, Cody Goodman > wrote: >> Could I somehow add a Wreq.Session.Session to my monad transformer >> stack? Should I use something other than Wreq? How would I create a >> default Session, Wreq doesn't seem to export the constructor. >> Basically I want to achieve Sessions/cookie handling. >> >> lpaste of my code: >> http://lpaste.net/114405 >> >> >> my full code (for those who want to view in email): >> >> {-# LANGUAGE OverloadedStrings #-} >> module Network.Scraper.State where >> >> import Control.Lens ((^.)) >> import Control.Monad >> import Control.Monad.IO.Class (liftIO) >> import qualified Control.Monad.Trans.State.Strict as ST >> import qualified Data.ByteString.Lazy as LBS >> import Data.Maybe (fromJust, fromMaybe) >> import Data.Monoid >> import qualified Data.Text as T >> import qualified Data.Text.IO as TIO >> import Network.Wreq (FormParam (..)) >> import qualified Network.Wreq as Wreq >> import Network.Wreq.Session (Session (..), withSession) >> import qualified Network.Wreq.Session as Sesh >> import Network.Wreq.Types >> import Safe >> import Text.HTML.DOM (parseLBS) >> import Text.XML.Cursor >> import qualified Text.XML.Cursor.Generic as CG >> >> >> data ScraperState = >> PS { currentOptions :: Wreq.Options >> , currentHtml :: LBS.ByteString >> , currentCursor :: Maybe Cursor >> , currentSession :: Session >> } deriving (Show) >> >> type Scraper = ST.StateT ScraperState IO >> >> toCursor = fromDocument . parseLBS >> >> initialSt = >> PS { currentOptions = Wreq.defaults >> , currentHtml = ("" :: LBS.ByteString) >> , currentCursor = Nothing >> -- , currentSession = ... how do I get a Session? Wreq doesn't >> seem to export this type >> } >> >> setCurrentOptions :: Wreq.Options -> Scraper () >> setCurrentOptions o = do >> scraper <- ST.get >> ST.put $ scraper { currentOptions = o } >> >> -- getCurrentPage :: Shpider Page >> getCurrentCursor :: Scraper (Maybe Cursor) >> getCurrentCursor = do >> scraper <- ST.get >> return $ currentCursor scraper >> >> getCurrentSession :: Scraper (Session) >> getCurrentSession = do >> scraper <- ST.get >> return $ currentSession scraper >> >> setCurrentSession :: Session -> Scraper () >> setCurrentSession s = do >> scraper <- ST.get >> ST.put $ scraper { currentSession = s} >> >> setCurrentCursor :: Cursor -> Scraper ( ) >> setCurrentCursor c = do >> scraper <- ST.get >> ST.put $ scraper { currentCursor = Just c } >> >> setCurrentHtml :: LBS.ByteString -> Scraper () >> setCurrentHtml html = do >> scraper <- ST.get >> ST.put $ scraper { currentHtml = html } >> >> runScraper :: Scraper a -> IO a >> runScraper k = evalScraperWith k initialSt >> >> evalScraperWith :: Scraper a -> ScraperState -> IO a >> evalScraperWith k s = withSession $ \sesh -> do >> -- set the current session to the mutable session variable >> return $ setCurrentSession sesh >> ST.evalStateT k s >> >> formShortInfo' f = formInfo' >> where >> go Nothing = "N/A" >> go (Just x) = x >> formInfo = (headMay . attribute "name" $ f, headMay . attribute >> "action" $ f) >> formInfo' = (\(x,y) -> (go x, go y)) formInfo >> >> ppTuple :: (T.Text, T.Text) -> T.Text >> ppTuple = \(x,y) -> "[" <> x <> "]" <> ": " <> y >> >> -- move to ../Spider.hs >> printFormNames :: Scraper () >> printFormNames = do >> c <- getCurrentCursor >> let c' = fromMaybe (error "No cursor set") c >> forms = c' $// element "form" >> formInfo = map (ppTuple . formShortInfo') forms >> liftIO $ mapM_ (TIO.putStrLn) formInfo >> >> getFormByName :: T.Text -> Scraper [Cursor] >> getFormByName name = do >> c <- getCurrentCursor >> let c' = fromMaybe (error "No cursor set") c >> return $ c' $// element "form" >=> attributeIs "name" name >> >> get :: String -> Scraper (LBS.ByteString) >> get url = do >> r <- liftIO $ Wreq.get url >> let html = r ^. Wreq.responseBody >> setCurrentHtml html >> setCurrentCursor (toCursor html) >> return html >> >> post :: Postable a => String -> a -> Scraper (LBS.ByteString) >> post url params = do >> r <- liftIO $ Wreq.post url params >> let html = r ^. Wreq.responseBody >> setCurrentHtml html >> setCurrentCursor (toCursor html) >> return html >> >> test :: Scraper () >> test = do >> get "https://www.google.com" >> printFormNames >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe > > > > -- > https://lambda.xyz From fumiexcel at gmail.com Mon Nov 17 06:37:47 2014 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Mon, 17 Nov 2014 15:37:47 +0900 Subject: [Haskell-cafe] [ANN] elevator: getting to a top of a monad transformer stack Message-ID: Hello everybody, I created an elevator to navigate a monad transformer stack, liberating us from creating a Monad* class and instances. The key function, elevate, can be whatever you need: elevate :: IO a -> IO a elevate :: IO a -> StateT s IO a elevate :: State s a -> StateT s IO a elevate :: IO a -> MaybeT (StateT s IO) a If you want to elevate actions above your monad, just write instance Tower YourMonad to declare that YourMonad is one-storied. Hackage: http://hackage.haskell.org/package/elevator-0.1/docs/Control-Elevator.html Cheers Fumiaki Kinoshita -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Mon Nov 17 09:17:27 2014 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 17 Nov 2014 09:17:27 +0000 Subject: [Haskell-cafe] [Haskell] ANNOUNCE: Haskell Communities and Activities Report (27th ed., November 2014) In-Reply-To: References: Message-ID: <618BE556AADD624C9C918AA5D5911BEF3F3C37C2@DB3PRD3001MB020.064d.mgd.msft.net> Friends With each issue of the Haskell Communities and Activities Report I am freshly awed by the range and creativity of the things you are all doing with Haskell. From web frameworks to bioinformatics, from automatic differentiation to GUIs and games. Amazing stuff. I think we owe the editors, Mihai Maruseac and Alejandro Serrano Mena, a huge debt for putting it together. Thank you! Simon | -----Original Message----- | From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf | Of Mihai Maruseac | Sent: 17 November 2014 02:03 | To: Haskell; haskell; Haskell Beginners; Lista principala | Subject: [Haskell-cafe] [Haskell] ANNOUNCE: Haskell Communities and | Activities Report (27th ed., November 2014) | | On behalf of all the contributors, we are pleased to announce that the | | Haskell Communities and Activities Report | (27th edition, November 2014) | | is now available, in PDF and HTML formats: | | http://haskell.org/communities/11-2014/report.pdf | http://haskell.org/communities/11-2014/html/report.html From roma at ro-che.info Mon Nov 17 16:27:25 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Mon, 17 Nov 2014 18:27:25 +0200 Subject: [Haskell-cafe] [ANN] elevator: getting to a top of a monad transformer stack In-Reply-To: References: Message-ID: <546A21ED.9020906@ro-che.info> I've done something similar in the monad-classes library [1]; and there's an ongoing series of articles about it [2]. [1]: https://github.com/feuerbach/monad-classes [2]: http://ro-che.info/articles/extensible-effects On 17/11/14 08:37, Fumiaki Kinoshita wrote: > Hello everybody, > > I created an elevator to navigate a monad transformer stack, liberating > us from creating a Monad* class and instances. > > The key function, elevate, can be whatever you need: > > elevate :: IO a -> IO a > > elevate :: IO a -> StateT s IO a > > elevate :: State s a -> StateT s IO a > > elevate :: IO a -> MaybeT (StateT s IO) a > > If you want to elevate actions above your monad, just write > > instance Tower YourMonad > > to declare that YourMonad is one-storied. > > Hackage: http://hackage.haskell.org/package/elevator-0.1/docs/Control-Elevator.html > > Cheers > > Fumiaki Kinoshita > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From donn at avvanta.com Mon Nov 17 21:11:39 2014 From: donn at avvanta.com (Donn Cave) Date: Mon, 17 Nov 2014 13:11:39 -0800 (PST) Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments In-Reply-To: References: Message-ID: <20141117211139.C26C9276C46@mail.avvanta.com> [... I said earlier ...] > I may be confused here - trying this out, I seem to be getting > garbage I don't understand from System.Environment getArgs. So I returned to this out of curiosity, and specifically, System.Environment getArgs converts common accented characters in ISO-8859-1 command line arguments, into values in the high 0xDC00's. Lower case umlaut u, for example, is 0xDCFC. These values, fed into Data.Text pack and encodeUtf8, seem to be garbage ... I get 3-byte UTF-8 that I highly doubt has anything to do with accented latin characters, actually the same "\239\191\189" even for different chars. But the lower bytes looked like Unicode values, and if the upper 0xDC00 is cleared, Data.Text pack and encodeUtf8 works. I'm no Unicode whiz, maybe this all makes sense? I'm not inconvenienced by this myself, my interest is only academic, just wondering what the extra 0xDC00 bits are for. And I should note that as far as I can make out, this doesn't match the remark at the beginning of this thread: "... does *not* contain the Unicode code points of the characters the user has entered. Instead the input bytes are mapped one-to-one to Char." I have GHC 7.8.3. thanks, Donn From ben.franksen at online.de Mon Nov 17 23:41:57 2014 From: ben.franksen at online.de (Ben Franksen) Date: Tue, 18 Nov 2014 00:41:57 +0100 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments References: <20141117211139.C26C9276C46@mail.avvanta.com> Message-ID: Donn Cave wrote: > [... I said earlier ...] >> I may be confused here - trying this out, I seem to be getting >> garbage I don't understand from System.Environment getArgs. > > So I returned to this out of curiosity, and specifically, > System.Environment getArgs converts common accented characters > in ISO-8859-1 command line arguments, into values in the > high 0xDC00's. Lower case umlaut u, for example, is 0xDCFC. > These values, fed into Data.Text pack and encodeUtf8, seem > to be garbage ... I get 3-byte UTF-8 that I highly doubt > has anything to do with accented latin characters, actually > the same "\239\191\189" even for different chars. > > But the lower bytes looked like Unicode values, and if the > upper 0xDC00 is cleared, Data.Text pack and encodeUtf8 works. > > I'm no Unicode whiz, maybe this all makes sense? I'm not > inconvenienced by this myself, my interest is only academic, > just wondering what the extra 0xDC00 bits are for. And I > should note that as far as I can make out, this doesn't match > the remark at the beginning of this thread: "... does *not* > contain the Unicode code points of the characters the user has > entered. Instead the input bytes are mapped one-to-one to Char." > I have GHC 7.8.3. Hi Donn I am sorry, I should have replied earlier here to say that I was *wrong*: GHC/base does not by default do what I claimed it does, as I learned later and you confirm now. It does that only if the program expressly demands it by specifying a so-called "char8" encoding, by initializing the global variable localeEncoding before the base library does it for you. With this you can override the user's locale as seen by GHC/base. I was working on Darcs and this is what Darcs does. But I was not aware of this hack and used to local reasoning in Haskell (doesn't Haskell claim to be a purely functional language?). Sorry for the confusion. And thanks for confirming that GHC and the base library do the right thing (if we let them). Cheers Ben -- "Make it so they have to reboot after every typo." -- Scott Adams From gautier.difolco at gmail.com Mon Nov 17 23:48:14 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Tue, 18 Nov 2014 00:48:14 +0100 Subject: [Haskell-cafe] The next 7000... abstractions to learn! Message-ID: Hi all, I'm using Haskell since nearly three years now and I think I have well understood that types are the most important part of our programs. I have looked all around to learn as many datatypes/typeclasses as possible. But I suffer for a lack of direction to pursue my learning. I have well understood Prelude's one and some random ones (include someones for Category Theory), but I can't handle Kmett's code. Are there some intermediates abstractions I can learn? (For example in some librairies). Thanks by advance for your help. Regards. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.franksen at online.de Mon Nov 17 23:51:28 2014 From: ben.franksen at online.de (Ben Franksen) Date: Tue, 18 Nov 2014 00:51:28 +0100 Subject: [Haskell-cafe] How to reverse ghc encoding of command line arguments References: <20141117211139.C26C9276C46@mail.avvanta.com> Message-ID: Ben Franksen wrote: > GHC/base does not by default do what I claimed it does, as I learned later > and you confirm now. It does that only if the program expressly demands it > by specifying a so-called "char8" encoding, by initializing the global > variable localeEncoding before the base library does it for you. With this > you can override the user's locale as seen by GHC/base. I was working on > Darcs and this is what Darcs does. But I was not aware of this hack and > used to local reasoning in Haskell (doesn't Haskell claim to be a purely > functional language?). I should perhaps add that I was also misled by the documentation in the base library, where at one place it says that setLocaleEncoding does not influence the value you get with getFileSystemEncoding (which is used to decode command line arguments and environment variables). This is true once the base library has initialized the variable, but since the initialization is lazy, as with all globals in Haskell, setLocaleEncoding does have an effect if you do it early enough. Perhaps this might be a worthwhile addition to the docs. Cheers Ben -- "Make it so they have to reboot after every typo." -- Scott Adams From cma at bitemyapp.com Mon Nov 17 23:59:14 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Mon, 17 Nov 2014 17:59:14 -0600 Subject: [Haskell-cafe] The next 7000... abstractions to learn! In-Reply-To: References: Message-ID: My recommended order for learning: Functor, Applicative, Monad Alt, Alternative, MonadPlus Foldable, Traversable Bifunctor, Bifoldable, Bitraversable Contravariant, Profunctor Strong, Choice Lens, Prism, Iso, Traversal Implement your own Van Laarhoven lenses. It's difficult, but tel/sdbo has a tutorial here: codewars.com/users/tel/authored (called Lensmaker) References/examples for aforementioned typelcasses: https://github.com/ekmett/semigroupoids (Alt) https://github.com/ekmett/either/blob/master/src/Data/Either/Validation.hs (Foldable, Traversable, Bi*, Profunctor, Choice, Iso) https://www.fpcomplete.com/school/to-infinity-and-beyond/pick-of-the-week/profunctors (Contravariant, Profunctor) https://www.youtube.com/watch?v=Go-RR_2I9CU my monad transformers talk has connected some dots for people on higher kinded types and type variable application (relevant to Contravariant and (->)) https://github.com/ekmett/lens/wiki/How-can-I-write-lenses-without-depending-on-lens%3F (Lens, Prism, Iso, Choice, Profunctor) Hope this helps, Chris Allen On Mon, Nov 17, 2014 at 5:48 PM, Gautier DI FOLCO wrote: > Hi all, > > I'm using Haskell since nearly three years now and I think I have well > understood that types are the most important part of our programs. > I have looked all around to learn as many datatypes/typeclasses as > possible. > But I suffer for a lack of direction to pursue my learning. I have well > understood Prelude's one and some random ones (include someones for > Category Theory), but I can't handle Kmett's code. Are there some > intermediates abstractions I can learn? (For example in some librairies). > > Thanks by advance for your help. > Regards. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From donn at avvanta.com Tue Nov 18 02:30:25 2014 From: donn at avvanta.com (Donn Cave) Date: Mon, 17 Nov 2014 18:30:25 -0800 (PST) Subject: [Haskell-cafe] How to reverse ghc encoding of command linearguments In-Reply-To: References: Message-ID: <20141118023025.D5773F3938@mail.avvanta.com> quoth Ben Franksen ... > Sorry for the confusion. And thanks for confirming that GHC and the base > library do the right thing (if we let them). Hm, that's my question -- how is this the right thing? Umlaut u turns up as 0xFC for UTF-8 users; 0xDCFC, for Latin-1 users. This is an ordinary hello world type program, can't think of any unique environmental issues. - So should we routinely run argv through a high-byte stripper? - I should learn to appreciate the high 0xDC00 byte, because it serves some purpose I wasn't aware of? - Am I somehow messing myself up, and this doesn't normally happen? - Or is the base library really not quite right here? Just curious, mind you! Donn From allbery.b at gmail.com Tue Nov 18 02:35:17 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 18 Nov 2014 02:35:17 +0000 Subject: [Haskell-cafe] How to reverse ghc encoding of command linearguments In-Reply-To: <20141118023025.D5773F3938@mail.avvanta.com> References: <20141118023025.D5773F3938@mail.avvanta.com> Message-ID: On Tue, Nov 18, 2014 at 2:30 AM, Donn Cave wrote: > quoth Ben Franksen > ... > > Sorry for the confusion. And thanks for confirming that GHC and the base > > library do the right thing (if we let them). > > Hm, that's my question -- how is this the right thing? > This sounds like a fossil. The first version of trying to support locales/encoding on POSIX did that to anything with the 8th bit set, IIRC, rather than make a possibly incorrect guess as to the intended locale (since POSIX does not support locales here; the argument vector is a list of octet strings). You could undo it and apply encoding yourself. I recall there being a "lively" discussion of it back in the day, but not what list it was on (may have been -cafe or libraries). -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From jon.fairbairn at cl.cam.ac.uk Tue Nov 18 10:03:23 2014 From: jon.fairbairn at cl.cam.ac.uk (Jon Fairbairn) Date: Tue, 18 Nov 2014 10:03:23 +0000 Subject: [Haskell-cafe] Generating valid html References: <5463E2D3.7040305@power.com.pl> <54665FA2.3030902@power.com.pl> Message-ID: Wojtek Narczy?ski writes: > On 13.11.2014 19:56, Evan Laforge wrote: >> >> WASH did that, a long time ago. They mentioned that they >> intentionally relaxed the rules, since being totally correct was >> annoying to actually use. There are docs here: >> http://www2.informatik.uni-freiburg.de/~thiemann/WASH/ >> > > Very nice package, I printed the paper, I'll look into it. > > I like renovating old Haskell (and Ada) software, it is > always so little work. When you?ve done that, do have a look at mine (as posted earlier, there?s a snapshot at http:///scrap.bookofsand.co.uk/HTMLs.tar.gz ). It enforces more of the restrictions in the standards, but uses some more modern Haskell to do it. -- J?n Fairbairn Jon.Fairbairn at cl.cam.ac.uk From haberg-1 at telia.com Tue Nov 18 10:06:33 2014 From: haberg-1 at telia.com (Hans Aberg) Date: Tue, 18 Nov 2014 11:06:33 +0100 Subject: [Haskell-cafe] OS X 10.10 Message-ID: The URL [1] says the platform ?Works even on 10.10 beta!?, however, OS X 10.10.1 has just been released. Is there anyone out there who does not run the beta? :-) 1. https://www.haskell.org/platform/mac.html From ducis_cn at 126.com Tue Nov 18 11:27:18 2014 From: ducis_cn at 126.com (ducis) Date: Tue, 18 Nov 2014 19:27:18 +0800 (CST) Subject: [Haskell-cafe] What could possibly be the reason of new GC-related problems after upgrading from ghc-7.6 to ghc-7.8.3 ? In-Reply-To: References: Message-ID: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> Recently I revived one of my projects set aside a year ago. As I'm an archlinux user, the ghc version has now inevitably become 7.8.3. Unfortunatly, the program starts to somehow have very bad GC performance (less than 50% productivity) . While I don't have the statistics of the older versions I'm pretty sure the current version has become visually less responsive. And if the user performs a series of actions in quick succession, the heap is not garbage collected in time and overflows. If the user performs the same actions with longer pauses then everything is fine. The GC seems to have become more loose in 7.8. There is quite a large underdocumented pile of code so I don't think posting it here would help. But can anyone give me a hint about what could be the reason? -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Tue Nov 18 14:24:25 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 18 Nov 2014 09:24:25 -0500 Subject: [Haskell-cafe] What could possibly be the reason of new GC-related problems after upgrading from ghc-7.6 to ghc-7.8.3 ? In-Reply-To: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> References: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> Message-ID: Have you done any heap profiling? Eg 7.6 vs 7.8 heap profiles? On Nov 18, 2014 8:45 AM, "ducis" wrote: > Recently I revived one of my projects set aside a year ago. As I'm an > archlinux user, the ghc version has now inevitably become 7.8.3. > Unfortunatly, the program starts to somehow have very bad GC performance > (less than 50% productivity) . While I don't have the statistics of the > older versions I'm pretty sure the current version has become visually less > responsive. And if the user performs a series of actions in quick > succession, the heap is not garbage collected in time and overflows. If the > user performs the same actions with longer pauses then everything is fine. > The GC seems to have become more loose in 7.8. > There is quite a large underdocumented pile of code so I don't think > posting it here would help. But can anyone give me a hint about what could > be the reason? > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ecrockett0 at gmail.com Tue Nov 18 14:38:43 2014 From: ecrockett0 at gmail.com (Eric Crockett) Date: Tue, 18 Nov 2014 06:38:43 -0800 (PST) Subject: [Haskell-cafe] How to Kill Haskell Message-ID: <20688b8a-b4e3-4e4c-a98c-a1c74e89f6aa@googlegroups.com> For the purposes of profiling a partially evaluated program, I'm interested in knowing the best way to terminate a GHC program. This is useful for profiling programs that take a long time to run, possibly as long as forever. It appears that *if* the program can be terminated with a single ^c, then profiling information is written to output. Sometimes, a single ^c doesn't kill the program, at not before I get impatient and hit ^c again. Usually two ^c will kill the program, but then no profiling data is written to output. As a simple example, Main.hs fib n = fib (n - 1) + fib (n - 2) main = print $ fib 100 Compiling with -prof and running with +RTS -p, I can kill this program with a *single* ^c in the first approximately 10 seconds of execution, but after that only two ^c will do the job. Looking at my resources, this change appears to coincide with the program using all of my physical memory and moving to swap space, however that could also be coincidental. Why does ^c work sometimes, but not other times for the same program? What is the easiest way to ensure that profiling data will get printed when the program does not terminate on its own? -------------- next part -------------- An HTML attachment was scrubbed... URL: From ecrockett0 at gmail.com Tue Nov 18 14:41:14 2014 From: ecrockett0 at gmail.com (Eric Crockett) Date: Tue, 18 Nov 2014 06:41:14 -0800 (PST) Subject: [Haskell-cafe] How to Kill Haskell In-Reply-To: <20688b8a-b4e3-4e4c-a98c-a1c74e89f6aa@googlegroups.com> References: <20688b8a-b4e3-4e4c-a98c-a1c74e89f6aa@googlegroups.com> Message-ID: <41dca42a-a3e4-47f4-9191-0cfe6f48ba6f@googlegroups.com> There's some information here , but that doesn't explain why ^c works sometimes and not others, nor if that is indeed the proper way to terminate a program. On Tuesday, November 18, 2014 9:38:43 AM UTC-5, Eric Crockett wrote: > > For the purposes of profiling a partially evaluated program, I'm > interested in knowing the best way to terminate a GHC program. This is > useful for profiling programs that take a long time to run, possibly as > long as forever. It appears that *if* the program can be terminated with a > single ^c, then profiling information is written to output. Sometimes, a > single ^c doesn't kill the program, at not before I get impatient and hit > ^c again. Usually two ^c will kill the program, but then no profiling data > is written to output. As a simple example, > > Main.hs > fib n = fib (n - 1) + fib (n - 2) > main = print $ fib 100 > > Compiling with -prof and running with +RTS -p, I can kill this program > with a *single* ^c in the first approximately 10 seconds of execution, but > after that only two ^c will do the job. Looking at my resources, this > change appears to coincide with the program using all of my physical memory > and moving to swap space, however that could also be coincidental. > > Why does ^c work sometimes, but not other times for the same program? What > is the easiest way to ensure that profiling data will get printed when the > program does not terminate on its own? > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ducis_cn at 126.com Tue Nov 18 14:46:56 2014 From: ducis_cn at 126.com (ducis) Date: Tue, 18 Nov 2014 22:46:56 +0800 (CST) Subject: [Haskell-cafe] What could possibly be the reason of new GC-related problems after upgrading from ghc-7.6 to ghc-7.8.3 ? In-Reply-To: References: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> Message-ID: <47cf47bb.291f2.149c35ee3f9.Coremail.ducis_cn@126.com> I have done heap profiling on 7.8 and identified several hot spots but returning to 7.6 requires pretty a lot of configuration and waiting. There are hotspots, but as I have mentioned the code is convoluted and I don't think anyone will be able to really understand the code snippets if I post them here. I'm mainly looking for general hints and heuristics about how the GC would behave differently when upgraded to 7.8. At 2014-11-18 22:24:25, "Carter Schonwald" wrote: Have you done any heap profiling? Eg 7.6 vs 7.8 heap profiles? On Nov 18, 2014 8:45 AM, "ducis" wrote: Recently I revived one of my projects set aside a year ago. As I'm an archlinux user, the ghc version has now inevitably become 7.8.3. Unfortunatly, the program starts to somehow have very bad GC performance (less than 50% productivity) . While I don't have the statistics of the older versions I'm pretty sure the current version has become visually less responsive. And if the user performs a series of actions in quick succession, the heap is not garbage collected in time and overflows. If the user performs the same actions with longer pauses then everything is fine. The GC seems to have become more loose in 7.8. There is quite a large underdocumented pile of code so I don't think posting it here would help. But can anyone give me a hint about what could be the reason? _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe at haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicola.gigante at gmail.com Tue Nov 18 15:35:34 2014 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Tue, 18 Nov 2014 16:35:34 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. Message-ID: Hello everybody I would kindly ask you to take a look at this code and tell me your opinions: https://gist.github.com/nicola-gigante/43533ce907f88a6aba16 The file try to implement a list-like data type, based on function composition to achieve a constant-time appending operation (in contrast to linear (++)). I?m sure this is something old. If you have material that covers an approach like this, please tell me. I?ve tried to implement all the type classes that I currently use, and it seems to work. Also, all the operations of those typeclasses seems to preserve the original laziness properties, despite I was expecting the contrary. A list in this code is basically a function that?s constructed by composing a lot of partially applied cons operators. To obtain a plain list from it, it?s sufficient to apply the empty list at the end. So I was expecting that to evaluate even the first element of the list, the code would have to evaluate all the function composition chain to obtain the entire function to being able to apply the final argument. It seems not true, since this code can still manipulate infinite lists. For example: > fmap (*2) . fromList $ repeat 42 This code prints an infinite stream of ?84? numbers in GHCI. It doesn?t wait to have the entire list to then print it out. In my understanding that means I?m building the list sufficiently lazily, or am I missing something? In the case this actually means my datatype is lazy enough, why isn?t it more strict instead, following the above reasoning? Is it the case that haskell laziness extends to partially constructed functions? Also, the implementation is very simple. Basically I use the list functions and go back and forth with toList/fromList. It all seems too easy? am I wasting a lot of time or space somewhere? Thank you a lot for your help, Greetings, Nicola -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Tue Nov 18 15:49:15 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Tue, 18 Nov 2014 16:49:15 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: References: <5463E2D3.7040305@power.com.pl> <54665FA2.3030902@power.com.pl> Message-ID: <546B6A7B.3000702@power.com.pl> On 18.11.2014 11:03, Jon Fairbairn wrote: > > When you?ve done that, do have a look at mine (as posted > earlier, there?s a snapshot at > http:///scrap.bookofsand.co.uk/HTMLs.tar.gz ). It enforces more > of the restrictions in the standards, but uses some more modern > Haskell to do it. > I have had a look, but frankly, the syntax of the html generating codes is not as readable as in WASH. I've also found WASH SUPER [1], which shows how to create type leve finite automatons [2], a bit like xhaskell. I found it interesting, and applicable beyond a DSL for HTML. I'm trying to fit the type level finite automaton concept into the Monad class, but this doesn't seem to work with the stock Monad class definition. Any guidance here, dear List? [1] http://www2.informatik.uni-freiburg.de/~thiemann/WASH/WASP-SUPER.tgz [2] http://www2.informatik.uni-freiburg.de/~thiemann/papers/modeling.pdf -- Kind regards, Wojtek Narczynski From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 18 15:50:24 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 18 Nov 2014 15:50:24 +0000 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: References: Message-ID: <20141118155024.GA17876@weber> On Tue, Nov 18, 2014 at 04:35:34PM +0100, Nicola Gigante wrote: > I would kindly ask you to take a look at this code and tell me your opinions: > > https://gist.github.com/nicola-gigante/43533ce907f88a6aba16 [..] > I?m sure this is something old. If you have material that covers an approach like this, > please tell me. It seems that you have discovered the "DList". http://hackage.haskell.org/package/dlist-0.7.1/docs/Data-DList.html From serge.lehuitouze at gmail.com Tue Nov 18 15:59:38 2014 From: serge.lehuitouze at gmail.com (Serge Le Huitouze) Date: Tue, 18 Nov 2014 16:59:38 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: References: Message-ID: > (...) > The file try to implement a list-like data type, based on function > composition to achieve > a constant-time appending operation (in contrast to linear (++)). > > I?m sure this is something old. If you have material that covers an approach > like this, please tell me. There is this paper of ICLP 1991 (even though the implementation language is lambda-Prolog): "Naive Reverse can be Linear", by Brisset P. and Ridoux O. http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.24.8975 Which itself, references this paper of 1986 Information Processing Letters (n? 22, pp. 141-144): "A novel representationof lists and its application to the function ?reverse?", by Hugues R.J.M. http://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/lists.pdf Regards. --Serge From nicola.gigante at gmail.com Tue Nov 18 16:07:21 2014 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Tue, 18 Nov 2014 17:07:21 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: References: Message-ID: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> > Il giorno 18/nov/2014, alle ore 16:59, Serge Le Huitouze ha scritto: > >> (...) >> The file try to implement a list-like data type, based on function >> composition to achieve >> a constant-time appending operation (in contrast to linear (++)). >> >> I?m sure this is something old. If you have material that covers an approach >> like this, please tell me. > > There is this paper of ICLP 1991 (even though the implementation language > is lambda-Prolog): "Naive Reverse can be Linear", by Brisset P. and Ridoux O. > http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.24.8975 > > Which itself, references this paper of 1986 Information Processing Letters > (n? 22, pp. 141-144): "A novel representationof lists and its application to > the function ?reverse?", by Hugues R.J.M. > http://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/lists.pdf > > Thank you Serge and Tom for your quick answers! I?m surely going to read those paper, and use Data.DList instead of my own implementation, to not reinvent the wheel. What about my doubts on why it works so lazily? > Regards. > > ?Serge Greetings, Nicola From carter.schonwald at gmail.com Tue Nov 18 16:30:23 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 18 Nov 2014 11:30:23 -0500 Subject: [Haskell-cafe] What could possibly be the reason of new GC-related problems after upgrading from ghc-7.6 to ghc-7.8.3 ? In-Reply-To: <47cf47bb.291f2.149c35ee3f9.Coremail.ducis_cn@126.com> References: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> <47cf47bb.291f2.149c35ee3f9.Coremail.ducis_cn@126.com> Message-ID: Please share the code or a minimal repro of the problem or there is no way to help On Nov 18, 2014 9:48 AM, "ducis" wrote: > I have done heap profiling on 7.8 and identified several hot spots but > returning to 7.6 requires pretty a lot of configuration and waiting. There > are hotspots, but as I have mentioned the code is convoluted and I don't > think anyone will be able to really understand the code snippets if I post > them here. I'm mainly looking for general hints and heuristics about how > the GC would behave differently when upgraded to 7.8. > > > > > > At 2014-11-18 22:24:25, "Carter Schonwald" > wrote: > > Have you done any heap profiling? Eg 7.6 vs 7.8 heap profiles? > On Nov 18, 2014 8:45 AM, "ducis" wrote: > >> Recently I revived one of my projects set aside a year ago. As I'm an >> archlinux user, the ghc version has now inevitably become 7.8.3. >> Unfortunatly, the program starts to somehow have very bad GC performance >> (less than 50% productivity) . While I don't have the statistics of the >> older versions I'm pretty sure the current version has become visually less >> responsive. And if the user performs a series of actions in quick >> succession, the heap is not garbage collected in time and overflows. If the >> user performs the same actions with longer pauses then everything is fine. >> The GC seems to have become more loose in 7.8. >> There is quite a large underdocumented pile of code so I don't think >> posting it here would help. But can anyone give me a hint about what could >> be the reason? >> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ariep at xs4all.nl Tue Nov 18 16:37:25 2014 From: ariep at xs4all.nl (Arie Peterson) Date: Tue, 18 Nov 2014 17:37:25 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> References: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> Message-ID: <1876820.N7RCl9Nq7q@u017021> > What about my doubts on why it works so lazily? Suppose 'f' is the function '(1 :)', and 'g' is some other unspecified other function of type '[Integer] -> [Integer]' ("difference list"). You may evaluate the concatenation '(f . g) []' like this: (f . g) [] = f (g []) = 1 : g [] and at this point, you already have partial knowledge of the resulting list. Note that we use "lazy evaluation", in the sense that we do not evaluate the argument 'g []' to the function 'f' right away, but proceed by first substituting the definition of 'f'. From stuart at cs.uchicago.edu Tue Nov 18 16:45:55 2014 From: stuart at cs.uchicago.edu (Stuart A. Kurtz) Date: Tue, 18 Nov 2014 10:45:55 -0600 Subject: [Haskell-cafe] Parsing error in Haskell2010 Message-ID: Dear Cafe, I recently ran into a Haskell2010 parsing error with code that parses just fine under Haskell98, and it seems to me that this might be an unintended consequence. Briefly, I have runModel :: StdGen -> Model () -> Result where Model is a monadic type, and then my main was main :: IO () main = do gen <- getStdGen let log = runModel gen $ do initialize 72 report replicateM_ 50 $ do replicateM_251 migrate report putStr . format $ log Haskell 2010 doesn't like the additional level of indentation after the "let log" line. If I pull the content of the "do" into a separate definition, so this becomes let log = runModel gen simulate the parsing error goes away. Questions: 1) Is this intended? 2) Can this code be formatted in a way to make Haskell 2010 happy? Many thanks. Peace, Stu From bneijt at gmail.com Tue Nov 18 17:02:12 2014 From: bneijt at gmail.com (Bram Neijt) Date: Tue, 18 Nov 2014 18:02:12 +0100 Subject: [Haskell-cafe] ISO 8601 Date time format without old-locale? Message-ID: I want to do ISO8601 formatting of a date with a numeric zone offset and I can't seem to find a way of doing it without requiring the old-locale package[1]. What is the current method of obtaining and formatting time representation if old-locale is old? Greetings, Bram [1] A sketch of the code using old-locale: -- 2014-11-18T06:37:04+00:00 iso8601DateTimeFormat :: String iso8601DateTimeFormat = "%FT%T%z" main = do now <- getCurrentTime putStrLn $ formatTime defaultTimeLocale iso8601DateTimeFormat now Which requires "defaultTimeLocale" from the old-locale package. From allbery.b at gmail.com Tue Nov 18 18:10:47 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 18 Nov 2014 18:10:47 +0000 Subject: [Haskell-cafe] ISO 8601 Date time format without old-locale? In-Reply-To: References: Message-ID: On Tue, Nov 18, 2014 at 5:02 PM, Bram Neijt wrote: > I want to do ISO8601 formatting of a date with a numeric zone offset > and I can't seem to find a way of doing it without requiring the > old-locale package[1]. > Use old-locale. It was inappropriately deprecated with no replacement, and nobody seems to want to bother either fixing or replacing it. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicola.gigante at gmail.com Tue Nov 18 18:34:42 2014 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Tue, 18 Nov 2014 19:34:42 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: <1876820.N7RCl9Nq7q@u017021> References: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> <1876820.N7RCl9Nq7q@u017021> Message-ID: Il giorno 18/nov/2014, alle ore 17:37, Arie Peterson ha scritto: >> What about my doubts on why it works so lazily? > > Suppose 'f' is the function '(1 :)', and 'g' is some other unspecified other > function of type '[Integer] -> [Integer]' ("difference list"). > > You may evaluate the concatenation '(f . g) []' like this: > > (f . g) [] > = f (g []) > = 1 : g [] > > and at this point, you already have partial knowledge of the resulting list. > > Note that we use "lazy evaluation", in the sense that we do not evaluate the > argument 'g []' to the function 'f' right away, but proceed by first > substituting the definition of 'f?. Thanks, that makes sense, but it still seem to me that it depends on the order of application of the composition operator. For example, what if the structure has been constructed by a left fold, so I have: ((((((f . g) . h) ?..) In this case, the evaluation have to descend ?n? thunks to find the first function to apply, so I can?t handle infinite lists. On the other hand, I can?t handle such an infinite list from a left fold anyway, so maybe that?s the point? Speaking about this ?difference list? more generally, which are the negative sides of using such a data structure? For example, when should I use Data.Sequence, for example, that requires Ord on my data types, while DList offers more or less the same features (or am I missing something?) Performance? Thank you very much, Nicola From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Nov 18 18:28:50 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 18 Nov 2014 18:28:50 +0000 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> References: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> Message-ID: <20141118182849.GC17876@weber> On Tue, Nov 18, 2014 at 05:07:21PM +0100, Nicola Gigante wrote: > I?m surely going to read those paper, and use Data.DList instead of > my own implementation, to not reinvent the wheel. > > What about my doubts on why it works so lazily? I don't know why you'd be doubtful about laziness. It seems perfectly lazy to me. I wrote the post a while ago on how DList works. Perhaps it will help you. http://h2.jaguarpaw.co.uk/posts/demystifying-dlist/ Tom From atzeus at gmail.com Tue Nov 18 19:30:28 2014 From: atzeus at gmail.com (Atze van der Ploeg) Date: Tue, 18 Nov 2014 20:30:28 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: <1876820.N7RCl9Nq7q@u017021> References: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> <1876820.N7RCl9Nq7q@u017021> Message-ID: You might also be intrested in my and oleg's paper "reflection without remorse" which discusses this construction in a more general setting, the problems with it and their solution Paper: http://homepages.cwi.nl/~ploeg/papers/zseq.pdf Talk: https://www.youtube.com/watch?v=_XoI65Rxmss On Nov 18, 2014 5:38 PM, "Arie Peterson" wrote: > > What about my doubts on why it works so lazily? > > Suppose 'f' is the function '(1 :)', and 'g' is some other unspecified > other > function of type '[Integer] -> [Integer]' ("difference list"). > > You may evaluate the concatenation '(f . g) []' like this: > > (f . g) [] > = f (g []) > = 1 : g [] > > and at this point, you already have partial knowledge of the resulting > list. > > Note that we use "lazy evaluation", in the sense that we do not evaluate > the > argument 'g []' to the function 'f' right away, but proceed by first > substituting the definition of 'f'. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From austin at well-typed.com Tue Nov 18 19:31:01 2014 From: austin at well-typed.com (Austin Seipp) Date: Tue, 18 Nov 2014 13:31:01 -0600 Subject: [Haskell-cafe] NOTE: the primary webserver is going down for immediate maintenance. Message-ID: Hello *, The primary haskell.org domain, www.haskell.org, is hosted on a system which seems to have lost one of its RAID disks completely. We were planning on moving this machine in the next few weeks to new infrastructure, but we are now expediting this plan and will be doing it ASAP. As we move this server, both the webserver and the mailing system will be going down. Please don't be alarmed if your emails aren't delivered or things go quiet. Many services will continue to work, but we do realize this will be upsetting for many. You can follow the progress on #haskell-infrastructure on Freenode, and see updates on https://status.haskell.org If you need to download something like a GHC binary or Haskell Platform package, you can use https://downloads.haskell.org in the mean time, which is a new service we were hoping to announce more officially soon, but is already working today. Unfortunately we cannot give an expected time of completion for the move, but we'll try to keep people well informed through IRC or something like Reddit. Thanks -- Regards, Austin Seipp, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From stuart at cs.uchicago.edu Tue Nov 18 19:31:26 2014 From: stuart at cs.uchicago.edu (Stuart A. Kurtz) Date: Tue, 18 Nov 2014 13:31:26 -0600 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: References: Message-ID: Dear Andy, > If that is the actual indentation in the file (and not just one or both of our mail clients breaking it), the problem is that the `let` line needs to start in the same column as the lines with `gen` and `putStr`. The gen, let, and putStr were properly aligned. After all, it compiled as Haskell98 ;-). > (Also, the inner do-block needs to be indented strictly further than the word `log`, in case it isn't in the original file.) This seems to be the issue. Haskell98 didn't require this, Haskell2010 does, and this seems less desirable to me. Isn't it reasonable to assume that the it's the do that dominates syntactically here, and not the let? Peace, Stu From mail at nh2.me Tue Nov 18 19:38:36 2014 From: mail at nh2.me (=?windows-1252?Q?Niklas_Hamb=FCchen?=) Date: Tue, 18 Nov 2014 20:38:36 +0100 Subject: [Haskell-cafe] ISO 8601 Date time format without old-locale? In-Reply-To: References: Message-ID: <546BA03C.7030004@nh2.me> Also maybe https://hackage.haskell.org/package/iso8601-time is useful for you. From erkokl at gmail.com Wed Nov 19 04:51:47 2014 From: erkokl at gmail.com (Levent Erkok) Date: Tue, 18 Nov 2014 20:51:47 -0800 Subject: [Haskell-cafe] [ANNOUNCE] New release of SBV (v3.2) Message-ID: I'm pleased to announce v3.2 release of SBV, providing facilities for SMT based theorem proving in Haskell. This is mainly a bug-fix/maintenance release, together with one new feature: SBV now implements 'sAssert', which works similar to 'assert' calls in Haskell or other languages to check that certain program invariants always hold. Except, SBV allows the condition to be symbolic, and all violations will be caught and reported as the underlying program is symbolically executed. (For instance, this facility can be useful in other DSL's built on top of SBV to make sure the code they generate never divides by 0, or indexes out of bounds.) Full release notes: https://github.com/LeventErkok/sbv /blob/master/CHANGES.md SBV web page: http://leventerkok.github.io/sbv/ As usual, bug reports and feedback are most welcome! -Levent. -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolasdiprima at gmail.com Tue Nov 18 22:14:12 2014 From: nicolasdiprima at gmail.com (Nicolas DI PRIMA) Date: Tue, 18 Nov 2014 22:14:12 +0000 Subject: [Haskell-cafe] ISO 8601 Date time format without old-locale? References: Message-ID: On Tue Nov 18 2014 at 6:11:06 PM Brandon Allbery wrote: > On Tue, Nov 18, 2014 at 5:02 PM, Bram Neijt wrote: > >> I want to do ISO8601 formatting of a date with a numeric zone offset >> and I can't seem to find a way of doing it without requiring the >> old-locale package[1]. >> > > Use old-locale. It was inappropriately deprecated with no replacement, and > nobody seems to want to bother either fixing or replacing it. > > You also can use hourglass (http://hackage.haskell.org/package/hourglass). I think it is a good replacement to 'time'. It also provides the ISO8601 Time format you need (see example below). I hope this will help you. import Data.Hourglass import System.Hourglass main :: IO () main = do tc <- timeCurrent putStrLn $ timePrint ISO8601_DateAndTime tc > 2014-11-18T22:06:50+00:00 -------------- next part -------------- An HTML attachment was scrubbed... URL: From tkoster at gmail.com Wed Nov 19 00:59:03 2014 From: tkoster at gmail.com (Thomas Koster) Date: Wed, 19 Nov 2014 11:59:03 +1100 Subject: [Haskell-cafe] Space leak in WAI 3.0 application Message-ID: Hello list, I am quite new to Haskell and I love the language and community, but I am frustrated by a space leak in a WAI 3.0 Application that for now just echoes the request entity back in the response. Specifically, I am having trouble understanding *why* I have the space leak. I intend to pass some or all of the request entity on to another web service whose response will influence the HTTP status code and headers of my service's response. At the moment, I am preparing the request entity as a lazy bytestring using lazy I/O just like Data.ByteString.Lazy.hGetContents does, at least until I can get around to learning pipes or conduit. When I use this technique to echo the request entity back in the response, it looks like two copies of the entire request entity are being accumulated in memory, presumably the original from the request and a copy for the response. The heap profile says it is all in "PINNED", which I am assuming are the bytestring buffers. However, the efficacy of this technique turns out to be irrelevant as I have been able to distill the problem down to a much simpler example: a WAI Application that responds with 100 MB of zeros read from /dev/zero using Data.ByteString.Lazy.hGetContents. I have prepared two variations that differ only in the composition of the operations. Both applications create identical responses, but version A accumulates the entire 100 MB entity in memory (heap profile shows a huge "PINNED" cost just over 100 MB in size) whereas version B streams the entity in constant space. Source code and a cabal file follow. I am using GHC 7.8.3. It is not necessary to make heap profiles - the symptoms are evident with "+RTS -s". ==== BEGIN Zeros.hs ==== {-# LANGUAGE OverloadedStrings #-} import Blaze.ByteString.Builder import Control.Concurrent import qualified Data.ByteString.Lazy as LBS import Data.Int import Network.HTTP.Types import Network.Wai import Network.Wai.Handler.Warp import System.IO -- | This version binds the large LBS of zeros /outside/ of the -- 'responseStream' body lambda. -- -- This version has the space leak. -- -- @ -- curl -v -o \/dev\/null localhost:3000\/zeros\/a -- @ zerosAppA :: Application zerosAppA _req respond = withZeros 100000000 $ \ largeLBS -> respond $ responseStream status200 [] $ \ write _flush -> write $ fromLazyByteString largeLBS -- | This version binds the large LBS of zeros /inside/ of the -- 'responseStream' body lambda. -- -- This version streams the response entity in constant space. -- -- @ -- curl -v -o \/dev\/null localhost:3000\/zeros\/b -- @ zerosAppB :: Application zerosAppB _req respond = respond $ responseStream status200 [] $ \ write _flush -> withZeros 100000000 $ \ largeLBS -> write $ fromLazyByteString largeLBS -- | Do something with /n/ bytes read lazily from @\/dev\/zero at . -- -- This part is common to both 'zerosAppA' and 'zerosAppB'. withZeros :: Int64 -> (LBS.ByteString -> IO a) -> IO a withZeros n f = withBinaryFile "/dev/zero" ReadMode $ \ h -> do zeros <- LBS.hGetContents h let largeLBS = LBS.take n zeros f largeLBS main :: IO () main = do _ <- forkIO $ run 3000 app putStrLn "Using port 3000. Press ENTER to exit..." _ <- getLine putStrLn "Exit." app :: Application app req respond = case pathInfo req of ["zeros", "a"] -> zerosAppA req respond ["zeros", "b"] -> zerosAppB req respond _ -> respond $ responseLBS status404 [] "Not found." ==== END Zeros.hs ==== ==== BEGIN zeros.cabal ==== name: zeros version: 0.1.0.0 build-type: Simple cabal-version: >=1.10 executable zeros main-is: Zeros.hs build-depends: base >=4.7 && <4.8, blaze-builder ==0.3.3.4, bytestring ==0.10.4.0, http-types ==0.8.5, wai ==3.0.2, warp ==3.0.2.3 default-language: Haskell2010 ghc-options: -Wall -rtsopts ==== END zeros.cabal ==== Why does version A not process the LBS in constant space? What in version A is preventing the GC from collecting the LBS chunks after they have been fed to Warp? What is it about version B that permits the LBS chunks to be collected? Although I believe the issue is not actually specific to WAI or Warp, I am unable to reproduce the space leak without them. But because I am new to Haskell, I suspect I have missed something obvious about lambda bindings, laziness (or strictness) of IO, and GC. Thanks. -- Thomas Koster From hjgtuyl at chello.nl Tue Nov 18 22:55:16 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Tue, 18 Nov 2014 23:55:16 +0100 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: References: Message-ID: On Tue, 18 Nov 2014 17:45:55 +0100, Stuart A. Kurtz wrote: [...] > where Model is a monadic type, and then my main was > > main :: IO () > main = do > gen <- getStdGen > let log = runModel gen $ do > initialize 72 > report > replicateM_ 50 $ do > replicateM_251 migrate > report > putStr . format $ log > > Haskell 2010 doesn't like the additional level of indentation after the > "let log" line. [...] > 2) Can this code be formatted in a way to make Haskell 2010 happy? The lines after the let must be indented more: main :: IO () main = do gen <- getStdGen let log = runModel gen $ do initialize 72 report replicateM_ 50 $ do replicateM_251 migrate report putStr . format $ log Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From matteo.ferrando2 at gmail.com Wed Nov 19 05:16:30 2014 From: matteo.ferrando2 at gmail.com (Matteo Ferrando) Date: Wed, 19 Nov 2014 00:46:30 -0430 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: References: Message-ID: > This seems to be the issue. Haskell98 didn't require this, Haskell2010 does, and this seems less desirable to me. Isn't it reasonable to assume that the it's the do that dominates syntactically here, and not the let? No, so you can do stuff like: main = do gen <- getStdGen let log = runModel gen $ do initialize 72 report replicateM_ 50 $ do replicateM_251 migrate report log' = runModel gen $ do initialize 42 report replicateM_ 50 $ do replicateM_251 migrate report log'' = runModel gen $ do initialize 42 report replicateM_ 50 $ do replicateM_251 migrate report putStr . format $ log putStr . format $ log' putStr . format $ log'' Defining `log`, `log'` and `log''` with the same `let`. Cheers, Matteo On Tue, Nov 18, 2014 at 3:01 PM, Stuart A. Kurtz wrote: > Dear Andy, > > > If that is the actual indentation in the file (and not just one or both > of our mail clients breaking it), the problem is that the `let` line needs > to start in the same column as the lines with `gen` and `putStr`. > > The gen, let, and putStr were properly aligned. After all, it compiled as > Haskell98 ;-). > > > (Also, the inner do-block needs to be indented strictly further than the > word `log`, in case it isn't in the original file.) > > This seems to be the issue. Haskell98 didn't require this, Haskell2010 > does, and this seems less desirable to me. Isn't it reasonable to assume > that the it's the do that dominates syntactically here, and not the let? > > Peace, > > Stu > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gautier.difolco at gmail.com Tue Nov 18 22:39:19 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Tue, 18 Nov 2014 23:39:19 +0100 Subject: [Haskell-cafe] The next 7000... abstractions to learn! In-Reply-To: References: Message-ID: 2014-11-18 0:59 GMT+01:00 Christopher Allen : > My recommended order for learning: > > > Functor, Applicative, Monad > > Alt, Alternative, MonadPlus > > Foldable, Traversable > > Bifunctor, Bifoldable, Bitraversable > > Contravariant, Profunctor > > Strong, Choice > > Lens, Prism, Iso, Traversal > > Implement your own Van Laarhoven lenses. It's difficult, but tel/sdbo has > a tutorial here: codewars.com/users/tel/authored (called Lensmaker) > > References/examples for aforementioned typelcasses: > > https://github.com/ekmett/semigroupoids (Alt) > > https://github.com/ekmett/either/blob/master/src/Data/Either/Validation.hs > (Foldable, Traversable, Bi*, Profunctor, Choice, Iso) > > > https://www.fpcomplete.com/school/to-infinity-and-beyond/pick-of-the-week/profunctors > (Contravariant, Profunctor) > > https://www.youtube.com/watch?v=Go-RR_2I9CU my monad transformers talk > has connected some dots for people on higher kinded types and type variable > application (relevant to Contravariant and (->)) > > > https://github.com/ekmett/lens/wiki/How-can-I-write-lenses-without-depending-on-lens%3F > (Lens, Prism, Iso, Choice, Profunctor) > > Hope this helps, > Chris Allen > > > > > > On Mon, Nov 17, 2014 at 5:48 PM, Gautier DI FOLCO < > gautier.difolco at gmail.com> wrote: > >> Hi all, >> >> I'm using Haskell since nearly three years now and I think I have well >> understood that types are the most important part of our programs. >> I have looked all around to learn as many datatypes/typeclasses as >> possible. >> But I suffer for a lack of direction to pursue my learning. I have well >> understood Prelude's one and some random ones (include someones for >> Category Theory), but I can't handle Kmett's code. Are there some >> intermediates abstractions I can learn? (For example in some librairies). >> >> Thanks by advance for your help. >> Regards. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > Hi Chris, Thanks for your answer, it appears that some of them are like hidden gems among code of more popular abstractions and you can easily don't care of them if you don't have such a guideline. Thanks a lot. -------------- next part -------------- An HTML attachment was scrubbed... URL: From davean at xkcd.com Wed Nov 19 05:47:25 2014 From: davean at xkcd.com (davean) Date: Wed, 19 Nov 2014 00:47:25 -0500 Subject: [Haskell-cafe] NOTE: the primary webserver is going down for immediate maintenance. In-Reply-To: References: Message-ID: At this time services are starting to come back. The site is very slow due to a temporary patch while we improve the connection to the database server. Please report issues other then slowness to the #haskell-infrastructure on Freenode. Apologies for the interruption you were forced to experience. On Tue, Nov 18, 2014 at 2:31 PM, Austin Seipp wrote: > Hello *, > > The primary haskell.org domain, www.haskell.org, is hosted on a system > which seems to have lost one of its RAID disks completely. > > We were planning on moving this machine in the next few weeks to new > infrastructure, but we are now expediting this plan and will be doing > it ASAP. > > As we move this server, both the webserver and the mailing system will > be going down. Please don't be alarmed if your emails aren't delivered > or things go quiet. Many services will continue to work, but we do > realize this will be upsetting for many. > > You can follow the progress on #haskell-infrastructure on Freenode, > and see updates on https://status.haskell.org > > If you need to download something like a GHC binary or Haskell > Platform package, you can use https://downloads.haskell.org in the > mean time, which is a new service we were hoping to announce more > officially soon, but is already working today. > > Unfortunately we cannot give an expected time of completion for the > move, but we'll try to keep people well informed through IRC or > something like Reddit. > > Thanks > > -- > Regards, > > Austin Seipp, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com/ > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Tue Nov 18 23:09:06 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 19 Nov 2014 01:09:06 +0200 Subject: [Haskell-cafe] ISO 8601 Date time format without old-locale? In-Reply-To: References: Message-ID: <546BD192.3030607@ro-che.info> On 18/11/14 20:10, Brandon Allbery wrote: > On Tue, Nov 18, 2014 at 5:02 PM, Bram Neijt > wrote: > > I want to do ISO8601 formatting of a date with a numeric zone offset > and I can't seem to find a way of doing it without requiring the > old-locale package[1]. > > > Use old-locale. It was inappropriately deprecated with no replacement, > and nobody seems to want to bother either fixing or replacing it. Actually, the time package has been fixed and now includes all the necessary definitions (and doesn't depend on old-locale) in version 1.5. Roman From david.feuer at gmail.com Tue Nov 18 21:49:23 2014 From: david.feuer at gmail.com (David Feuer) Date: Tue, 18 Nov 2014 16:49:23 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence Message-ID: I'd like to define (*>) and (>>) for Data.Seq.Seq in a "clever" way, like replicate, but I'm a bit stuck. It kind of looks like this is the purpose behind the applicativeTree function, which bills itself as a generalization of replicateA, but something seems to have gotten stuck and the only time I see applicativeTree actually used is to define replicateA. With all the fancy nesting, I'm a bit lost as to how to go about this, and having only one example doesn't really help. Can someone help give me a clue? Thanks, David -------------- next part -------------- An HTML attachment was scrubbed... URL: From atzeus at gmail.com Wed Nov 19 06:46:50 2014 From: atzeus at gmail.com (Atze van der Ploeg) Date: Wed, 19 Nov 2014 07:46:50 +0100 Subject: [Haskell-cafe] Code review: list-like datatype with constant time appending based on function composition. In-Reply-To: <20141118182849.GC17876@weber> References: <3D512E9B-76A6-4E10-A264-921FEF8EF95E@gmail.com> <20141118182849.GC17876@weber> Message-ID: Hi Tom, Your "Tree" construction does generalize to monads. Also see my paper and oleg's paper "reflection without remorse" referenced above. Cheers, Atze On Nov 19, 2014 5:46 AM, "Tom Ellis" < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Tue, Nov 18, 2014 at 05:07:21PM +0100, Nicola Gigante wrote: > > I?m surely going to read those paper, and use Data.DList instead of > > my own implementation, to not reinvent the wheel. > > > > What about my doubts on why it works so lazily? > > I don't know why you'd be doubtful about laziness. It seems perfectly lazy > to me. I wrote the post a while ago on how DList works. Perhaps it will > help you. > > http://h2.jaguarpaw.co.uk/posts/demystifying-dlist/ > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Tue Nov 18 23:23:39 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 19 Nov 2014 01:23:39 +0200 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: References: Message-ID: <546BD4FB.9010102@ro-che.info> To quote the GHC manual: In Haskell 98 mode and by default (but not in Haskell 2010 mode), GHC is a little less strict about the layout rule when used in do expressions. Specifically, the restriction that "a nested context must be indented further to the right than the enclosing context" is relaxed to allow the nested context to be at the same level as the enclosing context, if the enclosing context is a do expression. This behaviour is controlled by the NondecreasingIndentation extension. On 18/11/14 18:45, Stuart A. Kurtz wrote: > Dear Cafe, > > I recently ran into a Haskell2010 parsing error with code that parses just fine under Haskell98, and it seems to me that this might be an unintended consequence. > > Briefly, I have > > runModel :: StdGen -> Model () -> Result > > where Model is a monadic type, and then my main was > > main :: IO () > main = do > gen <- getStdGen > let log = runModel gen $ do > initialize 72 > report > replicateM_ 50 $ do > replicateM_251 migrate > report > putStr . format $ log > > Haskell 2010 doesn't like the additional level of indentation after the "let log" line. If I pull the content of the "do" into a separate definition, so this becomes > > let log = runModel gen simulate > > the parsing error goes away. > > Questions: > > 1) Is this intended? > 2) Can this code be formatted in a way to make Haskell 2010 happy? > > Many thanks. > > Peace, > > Stu From twilson at csufresno.edu Wed Nov 19 07:39:37 2014 From: twilson at csufresno.edu (Todd Wilson) Date: Tue, 18 Nov 2014 23:39:37 -0800 Subject: [Haskell-cafe] Forcing recomputation Message-ID: I'm curious: is there a reliable way to force Haskell to recompute a function application instead of sharing the result of the forced thunk? For example, suppose I have a function f and two arguments e1 and e2, and I want to compare the time it takes to compute f e1 vs. f e2, but ghci reports that each takes 0.00 sec (i.e., less than 0.005 sec) to compute. The traditional approach would be to compute each value a large number of times so that the total time becomes significant, except that all of the ways I can think of to do that in Haskell don't actually recompute the function application, but rather compute it once and share, or otherwise optimize away the redundant computation. Todd Wilson, PhD Department of Computer Science California State University, Fresno From cma at bitemyapp.com Wed Nov 19 07:52:26 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Wed, 19 Nov 2014 01:52:26 -0600 Subject: [Haskell-cafe] Forcing recomputation In-Reply-To: References: Message-ID: You could return it into IO couldn't you? Prelude> let f a = return (a + 1) Prelude> :t f f :: (Num a, Monad m) => a -> m a Prelude> let g = f :: Num a => a -> IO a Prelude> :t g g :: Num a => a -> IO a Prelude> let blah = g 1 Prelude> :t blah blah :: Num a => IO a Prelude> blah 2 Prelude> :sprint blah blah = _ --- Chris Allen On Wed, Nov 19, 2014 at 1:39 AM, Todd Wilson wrote: > I'm curious: is there a reliable way to force Haskell to recompute a > function application instead of sharing the result of the forced > thunk? For example, suppose I have a function f and two arguments e1 > and e2, and I want to compare the time it takes to compute f e1 vs. f > e2, but ghci reports that each takes 0.00 sec (i.e., less than 0.005 > sec) to compute. The traditional approach would be to compute each > value a large number of times so that the total time becomes > significant, except that all of the ways I can think of to do that in > Haskell don't actually recompute the function application, but rather > compute it once and share, or otherwise optimize away the redundant > computation. > > Todd Wilson, PhD > Department of Computer Science > California State University, Fresno > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Wed Nov 19 07:55:02 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Wed, 19 Nov 2014 07:55:02 +0000 Subject: [Haskell-cafe] Forcing recomputation In-Reply-To: References: Message-ID: <20141119075502.GI17876@weber> On Tue, Nov 18, 2014 at 11:39:37PM -0800, Todd Wilson wrote: > For example, suppose I have a function f and two arguments e1 > and e2, and I want to compare the time it takes to compute f e1 vs. f > e2 If your purpose is benchmarking (and even if it isn't) I suggest you look at how criterion manages the issue http://www.serpentine.com/criterion/tutorial.html From donn at avvanta.com Wed Nov 19 07:56:32 2014 From: donn at avvanta.com (Donn Cave) Date: Tue, 18 Nov 2014 23:56:32 -0800 (PST) Subject: [Haskell-cafe] How to reverse ghc encoding of commandline arguments In-Reply-To: <20141118023025.D5773F3938@mail.avvanta.com> References: <20141118023025.D5773F3938@mail.avvanta.com> Message-ID: <20141119075632.8840D93C2E@mail.avvanta.com> quoth Donn Cave ... > Umlaut u turns up as 0xFC for UTF-8 users; 0xDCFC, for Latin-1 users. > This is an ordinary hello world type program, can't think of any > unique environmental issues. Well, I mischaracterized that problem, so to speak. I find that GHC is not picking up on my "current locale" encoding, and instead seems to be hard-wired to UTF-8. On MacOS X, I can select an encoding in Terminal Preferences, open a new window, and for all intents and purposes it's an ISO8859-1 world, including LANG=en_US.ISO8859-1, but GHC isn't going along with it. So the ISO8859-1 umlaut u is undecodable if GHC is stuck in UTF-8, which seems to explain what I'm seeing. If I understand this right, the 0xDC00 high byte is recognized in some circumstances, and the value is spared from UTF-8 encoding and instead simply copied. Hope that was interesting! Donn From cma at bitemyapp.com Wed Nov 19 07:58:54 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Wed, 19 Nov 2014 01:58:54 -0600 Subject: [Haskell-cafe] Forcing recomputation In-Reply-To: <20141119075502.GI17876@weber> References: <20141119075502.GI17876@weber> Message-ID: Looks like http://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Exception.html#g:8 ? https://github.com/bos/criterion/blob/master/Criterion/Types.hs#L290-L295 On Wed, Nov 19, 2014 at 1:55 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Tue, Nov 18, 2014 at 11:39:37PM -0800, Todd Wilson wrote: > > For example, suppose I have a function f and two arguments e1 > > and e2, and I want to compare the time it takes to compute f e1 vs. f > > e2 > > If your purpose is benchmarking (and even if it isn't) I suggest you look > at > how criterion manages the issue > > http://www.serpentine.com/criterion/tutorial.html > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From torsten.grust at uni-tuebingen.de Wed Nov 19 08:45:42 2014 From: torsten.grust at uni-tuebingen.de (Torsten Grust) Date: Wed, 19 Nov 2014 09:45:42 +0100 Subject: [Haskell-cafe] Call for Participation: BOB Conference in Berlin (Jan 23, 2015) Message-ID: <8FB9DD6D-AEC5-4BFD-A228-82876EFA426C@uni-tuebingen.de> ================================================================ BOB 2015 Conference "What happens if we simply use what's best?" January 23.2015 Berlin http://bobkonf.de/2015/ Program: http://bobkonf.de/2015/programm.html Registration: http://bobkonf.de/2015/registration.html ================================================================ BOB is the conference for developers, architects and decision-makers to explore technologies beyond the mainstream in software development, and to find the best tools available to software developers today. Our goal is for all participants of BOB to return home with new insights that enable them to improve their own software development experiences. The program features 14 talks and 8 tutorials on current topics: http://bobkonf.de/2015/programm.html The subject range of talks includes functional programming, microservices, package management, and data management. The tutorials feature introductions to Erlang, Haskell, Swift, and ClojureScript, and their applications. Anil Madhavapeddy will hold the keynote talk - about unikernels and functional programming. Registration is open online: http://bobkonf.de/2015/registration.html NOTE: The early-bird rates expire on Dec. 19, 2014! BOB cooperates with the :clojured conference on the following day. There is a registration discount available for participants of both events. http://www.clojured.de/ From oleg at okmij.org Wed Nov 19 08:46:29 2014 From: oleg at okmij.org (oleg at okmij.org) Date: Wed, 19 Nov 2014 03:46:29 -0500 (EST) Subject: [Haskell-cafe] Generating valid html Message-ID: <20141119084629.B5594C3841@www1.g3.pair.com> I have sent the following message to Haskell-Cafe five days ago; it seems to have disappeared. I'm resending because HSXML answers your second question, of ensuring complex content constraints. I'm not sure why do you need Monad specifically? HSXML documents are particular monoids, which is what we want from documents. Generally speaking, all we need is a way to create primitive documents and to compose them into bigger ones. There are many more composition operations than monadic bind. Not everything is a monad and not everything has to be a monad. Old message: Somewhat related is the HSXML library for generating valid XML and HTML. To be precise, the library is designed to express in the type system content model constraints such as: block-level elements like DIV are allowed only in the block-level context; one cannot put DIV within H1, for example. Some items may be polymorphic: for example, TITLE appears in HEAD, it can be an attribute and it can be an element. It can be rendered differently in each case. The same HSXML document may be rendered as HTML or XML (or something else entirely, e.g., PDF). http://okmij.org/ftp/Scheme/xml.html#typed-SXML From ezyang at mit.edu Tue Nov 18 22:35:30 2014 From: ezyang at mit.edu (Edward Z. Yang) Date: Tue, 18 Nov 2014 14:35:30 -0800 Subject: [Haskell-cafe] What could possibly be the reason of new GC-related problems after upgrading from ghc-7.6 to ghc-7.8.3 ? In-Reply-To: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> References: <5f654931.13162.149c2a820bc.Coremail.ducis_cn@126.com> Message-ID: <1416350002-sup-6969@sabre> Hello Ducis, It's hard to say without more information. This sort of resembles behavior from "Thread behavior in 7.8.3"; you might try modifying the RTS flag -C to have a lower number (like 0.001). Edward Excerpts from ducis's message of 2014-11-18 03:27:18 -0800: > Recently I revived one of my projects set aside a year ago. As I'm an archlinux user, the ghc version has now inevitably become 7.8.3. Unfortunatly, the program starts to somehow have very bad GC performance (less than 50% productivity) . While I don't have the statistics of the older versions I'm pretty sure the current version has become visually less responsive. And if the user performs a series of actions in quick succession, the heap is not garbage collected in time and overflows. If the user performs the same actions with longer pauses then everything is fine. The GC seems to have become more loose in 7.8. > There is quite a large underdocumented pile of code so I don't think posting it here would help. But can anyone give me a hint about what could be the reason? From wojtek at power.com.pl Wed Nov 19 11:19:24 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Wed, 19 Nov 2014 12:19:24 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <20141119084629.B5594C3841@www1.g3.pair.com> References: <20141119084629.B5594C3841@www1.g3.pair.com> Message-ID: <546C7CBC.7070309@power.com.pl> On 19.11.2014 09:46, oleg at okmij.org wrote: > I'm not sure why do you need Monad specifically? Just because of the syntax. If one could have a drop-in layer over Blaze, one might actually use it, simply by changing the import statements. -- Thank you, Wojtek Narczynski From allbery.b at gmail.com Wed Nov 19 11:49:01 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Wed, 19 Nov 2014 11:49:01 +0000 Subject: [Haskell-cafe] How to reverse ghc encoding of commandline arguments In-Reply-To: <20141119075632.8840D93C2E@mail.avvanta.com> References: <20141118023025.D5773F3938@mail.avvanta.com> <20141119075632.8840D93C2E@mail.avvanta.com> Message-ID: On Wed, Nov 19, 2014 at 7:56 AM, Donn Cave wrote: > quoth Donn Cave > ... > > Umlaut u turns up as 0xFC for UTF-8 users; 0xDCFC, for Latin-1 users. > > This is an ordinary hello world type program, can't think of any > > unique environmental issues. > > Well, I mischaracterized that problem, so to speak. > > I find that GHC is not picking up on my "current locale" encoding, > and instead seems to be hard-wired to UTF-8. On MacOS X, I can > select an encoding in Terminal Preferences, open a new window, and > for all intents and purposes it's an ISO8859-1 world, including > LANG=en_US.ISO8859-1, but GHC isn't going along with it. > > So the ISO8859-1 umlaut u is undecodable if GHC is stuck in UTF-8, > which seems to explain what I'm seeing. If I understand this right, > the 0xDC00 high byte is recognized in some circumstances, and the > value is spared from UTF-8 encoding and instead simply copied. > ISO8859 is not multibyte. And your earlier description is incorrect, in a way showing a common confusion about the relationship between Unicode and UTF8 and ISO8859-1. U+00FC is the Unicode codepoint for u-umlaut. This is, by design, the same as the single byte sequence for u-umlaut (0xFC) in ISO8859-1. It is *not* the UTF8 representation of u-umlaut; that is 0xC3 0xBC. The 0xDC prefix is, as I said earlier, a hack used by ghc. Internally it only uses UTF8; so a non-UTF8 value which it needs to roundtrip from its external representation, which per POSIX has no encoding / is an octet string, to its internal representation is encoded as if it were UTF8 with a 0xDC prefix (stolen; that range belongs to Syriac) and then decoded back to the non-UTF8 external form by stripping the prefix. But this means that you will find yourself working with a "strange" Unicode codepoint. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From tdammers at gmail.com Wed Nov 19 12:17:35 2014 From: tdammers at gmail.com (Tobias Dammers) Date: Wed, 19 Nov 2014 13:17:35 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <546C7CBC.7070309@power.com.pl> References: <20141119084629.B5594C3841@www1.g3.pair.com> <546C7CBC.7070309@power.com.pl> Message-ID: <20141119121735.GB24596@nibbler> That's pretty much what my tamper library (http://hackage.haskell.org/package/tamper) is supposed to be. It's pretty rough around the edges still, and nowhere near as complete as Blaze itself, but it works well enough for basic HTML templating, and unlike Blaze, it is implemented as a monad transformer, which means you can integrate it with whatever monad stack you like. I couldn't find an existing solution to this myself, which is why I rolled my own. Having TamperT be a monad transformer is useful for things like passing template context around through a ReaderT, or for reading data from a database on-the-fly by having Tamper transform a monad that provides database access. It's not battle-proven production quality code (yet), so handle with care. On Wed, Nov 19, 2014 at 12:19:24PM +0100, Wojtek Narczy?ski wrote: > On 19.11.2014 09:46, oleg at okmij.org wrote: > >I'm not sure why do you need Monad specifically? > Just because of the syntax. If one could have a drop-in layer over Blaze, > one might actually use it, simply by changing the import statements. > > -- > Thank you, > Wojtek Narczynski > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -- Tobias Dammers - tobias at twokings.nl - 070-3457628 - www.twokings.nl Maandag t/m donderdag van 9.00 tot 17.30 Voor dringende vragen, mail naar support at twokings.nl From christiaan.baaij at gmail.com Wed Nov 19 12:40:45 2014 From: christiaan.baaij at gmail.com (Christiaan Baaij) Date: Wed, 19 Nov 2014 13:40:45 +0100 Subject: [Haskell-cafe] Dependently typed fold in GHC/Haskell Message-ID: Dear Cafe, I'm trying to convert the following Idris code, which compiles: > gfold : {p : Nat -> Type} > -> ((l : Nat) -> a -> p l -> p (S l)) > -> p 0 -> Vect k a -> p k > gfold _ z Nil = z > gfold f z ((::) {n} x xs) = f n x (gfold f z xs) > > gconcat : {m : Nat} -> Vect n a -> Vect m a -> Vect (n + m) a > gconcat {m} xs ys = gfold {p} f ys xs > where > p : Nat -> Type > p l = Vect (l + m) a > > f : (l : Nat) -> a -> Vect (l + m) a -> Vect (S (l + m)) a > f _ x r = x :: r To Haskell + various GHC extensions, which gives me type errors: > {-# LANGUAGE DataKinds, GADTs, KindSignatures, TypeOperators, RankNTypes, > ScopedTypeVariables, TypeFamilies #-} > > import Data.Proxy > > data Nat = Z | S Nat > > type family Plus (x :: Nat) (y :: Nat) :: Nat where > Plus Z y = y > Plus (S n) y = S (Plus n y) > > data Vec :: * -> Nat -> * where > Nil :: Vec a Z > (:>) :: a -> Vec a n -> Vec a (S n) > > gfold :: Proxy (p :: Nat -> *) > -> (forall l . Proxy l -> a -> p l -> p (S l)) > -> p Z -> Vec a k -> p k > gfold Proxy f z Nil = z > gfold Proxy f z (x :> xs) = f Proxy x (gfold Proxy f z xs) > > type family P (a :: *) (m :: Nat) (l :: Nat) :: * where > P a m l = Vec a (Plus l m) > > gconcat :: forall n m a . Vec a n -> Vec a m -> Vec a (Plus n m) > gconcat xs ys = gfold p f ys xs > where > p :: Proxy (P a m) > p = Proxy > > f :: forall (l :: Nat) . Proxy l -> a -> Vec a (Plus l m) > -> Vec a (S (Plus l m)) > f _ x r = x :> r I get the following errors: > VecTest.hs:25:25: > Couldn't match type ?l? with ?Plus l m? > ?l? is a rigid type variable bound by > a type expected by the context: > Proxy l -> a -> Vec a l -> Vec a ('S l) > at VecTest.hs:25:17 > Expected type: Proxy l -> a -> Vec a l -> Vec a ('S l) > Actual type: Proxy l > -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) > Relevant bindings include > p :: Proxy (P a m) (bound at VecTest.hs:28:5) > f :: forall (l :: Nat). > Proxy l -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) > (bound at VecTest.hs:32:5) > ys :: Vec a m (bound at VecTest.hs:25:12) > gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) > (bound at VecTest.hs:25:1) > In the second argument of ?gfold?, namely ?f? > In the expression: gfold p f ys xs > > VecTest.hs:25:27: > Couldn't match type ?m? with ?'Z? > ?m? is a rigid type variable bound by > the type signature for > gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) > at VecTest.hs:24:21 > Expected type: Vec a 'Z > Actual type: Vec a m > Relevant bindings include > p :: Proxy (P a m) (bound at VecTest.hs:28:5) > f :: forall (l :: Nat). > Proxy l -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) > (bound at VecTest.hs:32:5) > ys :: Vec a m (bound at VecTest.hs:25:12) > gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) > (bound at VecTest.hs:25:1) > In the third argument of ?gfold?, namely ?ys? > In the expression: gfold p f ys xs Is this kind of type-level programming just not yet possible in GHC? Or am I simply doing it wrong? Cheers, Christiaan From stuart at cs.uchicago.edu Wed Nov 19 12:45:08 2014 From: stuart at cs.uchicago.edu (Stuart A. Kurtz) Date: Wed, 19 Nov 2014 06:45:08 -0600 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: References: Message-ID: <99466A8E-887B-435D-8F71-E6F5F4DAF03F@cs.uchicago.edu> Dear Matteo, The surprise for me comes from the idea that the *amount* of indentation matters on establishing a new block, which hasn't been my experience with Haskell's offside rule before, although I tend to be 4-ist when it comes to indenting, and it's possible that this behavior has kept me on the good side thus far of rules that I wasn't aware of. So my instinct would have been to indent the code the way you've done below, but only if there were additional let bindings. It is particularly confusing that the error is reported as being on the "report" line, which seems to imply that the indentation of the previous line was ok (and therefore that the implicit block of which it is a part had been set up based on the do). It's nothing new to see syntax errors reported a line late -- the Pascal compilers did that! -- but unexpected here because GHC seems quite good about locating errors. Peace, Stu > On Nov 18, 2014, at 11:16 PM, Matteo Ferrando wrote: > > > This seems to be the issue. Haskell98 didn't require this, Haskell2010 does, and this seems less desirable to me. Isn't it reasonable to assume that the it's the do that dominates syntactically here, and not the let? > > No, so you can do stuff like: > > main = do > gen <- getStdGen > let log = runModel gen $ do > initialize 72 > report > replicateM_ 50 $ do > replicateM_251 migrate > report > log' = runModel gen $ do > initialize 42 > report > replicateM_ 50 $ do > replicateM_251 migrate > report > log'' = runModel gen $ do > initialize 42 > report > replicateM_ 50 $ do > replicateM_251 migrate > report > putStr . format $ log > putStr . format $ log' > putStr . format $ log'' > > Defining `log`, `log'` and `log''` with the same `let`. > > Cheers, > > Matteo From roma at ro-che.info Wed Nov 19 13:56:04 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 19 Nov 2014 15:56:04 +0200 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: <99466A8E-887B-435D-8F71-E6F5F4DAF03F@cs.uchicago.edu> References: <99466A8E-887B-435D-8F71-E6F5F4DAF03F@cs.uchicago.edu> Message-ID: <546CA174.4030000@ro-che.info> The first lexeme after let is log. Everything indented same as log (that is, starting at the same column as log) is considered to be bindings inside that let; everything indented more is considered to be continuation of a binding. In your original example, initialize is indented same as log, so ghc tries to parse it as a binding, and fails. The NondecreasingIndentation that I mentioned in the other email relaxes this constraint. On 19/11/14 14:45, Stuart A. Kurtz wrote: > Dear Matteo, > > The surprise for me comes from the idea that the *amount* of indentation matters on establishing a new block, which hasn't been my experience with Haskell's offside rule before, although I tend to be 4-ist when it comes to indenting, and it's possible that this behavior has kept me on the good side thus far of rules that I wasn't aware of. > > So my instinct would have been to indent the code the way you've done below, but only if there were additional let bindings. It is particularly confusing that the error is reported as being on the "report" line, which seems to imply that the indentation of the previous line was ok (and therefore that the implicit block of which it is a part had been set up based on the do). It's nothing new to see syntax errors reported a line late -- the Pascal compilers did that! -- but unexpected here because GHC seems quite good about locating errors. > > Peace, > > Stu > > >> On Nov 18, 2014, at 11:16 PM, Matteo Ferrando wrote: >> >>> This seems to be the issue. Haskell98 didn't require this, Haskell2010 does, and this seems less desirable to me. Isn't it reasonable to assume that the it's the do that dominates syntactically here, and not the let? >> >> No, so you can do stuff like: >> >> main = do >> gen <- getStdGen >> let log = runModel gen $ do >> initialize 72 >> report >> replicateM_ 50 $ do >> replicateM_251 migrate >> report >> log' = runModel gen $ do >> initialize 42 >> report >> replicateM_ 50 $ do >> replicateM_251 migrate >> report >> log'' = runModel gen $ do >> initialize 42 >> report >> replicateM_ 50 $ do >> replicateM_251 migrate >> report >> putStr . format $ log >> putStr . format $ log' >> putStr . format $ log'' >> >> Defining `log`, `log'` and `log''` with the same `let`. >> >> Cheers, >> >> Matteo > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From andres.loeh at gmail.com Wed Nov 19 14:37:12 2014 From: andres.loeh at gmail.com (=?UTF-8?Q?Andres_L=C3=B6h?=) Date: Wed, 19 Nov 2014 15:37:12 +0100 Subject: [Haskell-cafe] Dependently typed fold in GHC/Haskell In-Reply-To: References: Message-ID: Hi. You cannot partially apply a type family, as you try in >> type family P (a :: *) (m :: Nat) (l :: Nat) :: * where >> P a m l = Vec a (Plus l m) and then >> p :: Proxy (P a m) >> p = Proxy (The error message for this is not very good.) There are ways to work around this, for example with Richard's singletons library: > import Data.Proxy > import Data.Singletons > import Data.Singletons.Prelude > gfold :: Proxy (p :: TyFun Nat * -> *) > -> (forall l . Proxy l -> a -> p $ l -> p $ S l) > -> p $ Z -> Vec a k -> p $ k > gfold _ f z Nil = z > gfold p f z (x :> (xs :: Vec a l)) = f (Proxy :: Proxy l) x (gfold p f z xs) > data P (a :: *) (m :: Nat) (f :: TyFun Nat *) :: * > type instance Apply (P a m) l = Vec a (Plus l m) > gconcat :: forall n m a . Vec a n -> Vec a m -> Vec a (Plus n m) > gconcat xs ys = gfold (Proxy :: Proxy (P a m)) (const (:>)) ys xs Rest as before. Cheers, Andres From eir at cis.upenn.edu Wed Nov 19 14:59:51 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Wed, 19 Nov 2014 09:59:51 -0500 Subject: [Haskell-cafe] Dependently typed fold in GHC/Haskell In-Reply-To: References: Message-ID: <0E08A7C9-650D-4809-975F-0AFD15228557@cis.upenn.edu> You were really close, but there was a big leap that you would have to take before this would work. The fundamental problem is that you tried to use the `P` type family only partially applied. GHC does not allow partially-applied type functions. It is a bug in GHC 7.8.3 that no clear error is reported when you try to do so -- it is better in previous and later versions. (Specifically, I'm looking at the use of `P` in the type signature for `p` within `gconcat`.) I don't like this restriction, so co-author Jan Stolarek and I devised a workaround. The preliminary idea is explained in a blog post (http://typesandkinds.wordpress.com/2013/04/01/defunctionalization-for-the-win/) and the more developed idea in a paper (http://www.cis.upenn.edu/~eir/papers/2014/promotion/promotion.pdf). In short, we get around the restriction by using empty datatypes to represent type functions, and then we "apply" these datatypes using a `@@` open type family. The whole shebang is implemented in the `singletons` library. So, I edited your code to allow unsaturated calls to `P` (that's the `genDefunSymbols` line, below) and fixed the kinds in `gfold` to allow for partially-applied type families (which, in my workaround, have a different kind than normal type families). Then, I had to add a little more type-variable tracking in `gfold` to remove ambiguity. The binding and use of `n` appears in the Idris code, too. By using `proxy` instead of `Proxy`, I tell GHC that the proxy types should be the same. Idris doesn't need to know this because Idris uses higher-order unification, which is sometimes permitted to make guesses. GHC never makes guesses, so it needs a bit more information. In any case, here you go: > {-# LANGUAGE DataKinds, GADTs, KindSignatures, TypeOperators, RankNTypes, > ScopedTypeVariables, TypeFamilies, TemplateHaskell #-} > > import Data.Proxy > import Data.Singletons.TH ( genDefunSymbols ) > import Data.Singletons.Prelude ( type (@@), TyFun ) > > data Nat = Z | S Nat > > type family Plus (x :: Nat) (y :: Nat) :: Nat where > Plus Z y = y > Plus (S n) y = S (Plus n y) > > data Vec :: * -> Nat -> * where > Nil :: Vec a Z > (:>) :: a -> Vec a n -> Vec a (S n) > > gfold :: Proxy (p :: TyFun Nat * -> *) > -> (forall l . Proxy l -> a -> p @@ l -> p @@ (S l)) > -> p @@ Z -> Vec a k -> p @@ k > gfold Proxy _ z Nil = z > gfold proxy f z (x :> (xs :: Vec a n)) > = f (Proxy :: Proxy n) x (gfold proxy f z xs) > > type family P (a :: *) (m :: Nat) (l :: Nat) :: * where > P a m l = Vec a (Plus l m) > > $(genDefunSymbols [''P]) > > gconcat :: forall n m a . Vec a n -> Vec a m -> Vec a (Plus n m) > gconcat xs ys = gfold p f ys xs > where > p :: Proxy (PSym2 a m) > p = Proxy > > f :: forall (l :: Nat) . Proxy l -> a -> Vec a (Plus l m) > -> Vec a (S (Plus l m)) > f _ x r = x :> r > You'll need singletons-1.0 or later. That was fun! Thanks! Richard On Nov 19, 2014, at 7:40 AM, Christiaan Baaij wrote: > Dear Cafe, > > I'm trying to convert the following Idris code, which compiles: > >> gfold : {p : Nat -> Type} >> -> ((l : Nat) -> a -> p l -> p (S l)) >> -> p 0 -> Vect k a -> p k >> gfold _ z Nil = z >> gfold f z ((::) {n} x xs) = f n x (gfold f z xs) >> >> gconcat : {m : Nat} -> Vect n a -> Vect m a -> Vect (n + m) a >> gconcat {m} xs ys = gfold {p} f ys xs >> where >> p : Nat -> Type >> p l = Vect (l + m) a >> >> f : (l : Nat) -> a -> Vect (l + m) a -> Vect (S (l + m)) a >> f _ x r = x :: r > > To Haskell + various GHC extensions, which gives me type errors: > >> {-# LANGUAGE DataKinds, GADTs, KindSignatures, TypeOperators, RankNTypes, >> ScopedTypeVariables, TypeFamilies #-} >> >> import Data.Proxy >> >> data Nat = Z | S Nat >> >> type family Plus (x :: Nat) (y :: Nat) :: Nat where >> Plus Z y = y >> Plus (S n) y = S (Plus n y) >> >> data Vec :: * -> Nat -> * where >> Nil :: Vec a Z >> (:>) :: a -> Vec a n -> Vec a (S n) >> >> gfold :: Proxy (p :: Nat -> *) >> -> (forall l . Proxy l -> a -> p l -> p (S l)) >> -> p Z -> Vec a k -> p k >> gfold Proxy f z Nil = z >> gfold Proxy f z (x :> xs) = f Proxy x (gfold Proxy f z xs) >> >> type family P (a :: *) (m :: Nat) (l :: Nat) :: * where >> P a m l = Vec a (Plus l m) >> >> gconcat :: forall n m a . Vec a n -> Vec a m -> Vec a (Plus n m) >> gconcat xs ys = gfold p f ys xs >> where >> p :: Proxy (P a m) >> p = Proxy >> >> f :: forall (l :: Nat) . Proxy l -> a -> Vec a (Plus l m) >> -> Vec a (S (Plus l m)) >> f _ x r = x :> r > > I get the following errors: > >> VecTest.hs:25:25: >> Couldn't match type ?l? with ?Plus l m? >> ?l? is a rigid type variable bound by >> a type expected by the context: >> Proxy l -> a -> Vec a l -> Vec a ('S l) >> at VecTest.hs:25:17 >> Expected type: Proxy l -> a -> Vec a l -> Vec a ('S l) >> Actual type: Proxy l >> -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) >> Relevant bindings include >> p :: Proxy (P a m) (bound at VecTest.hs:28:5) >> f :: forall (l :: Nat). >> Proxy l -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) >> (bound at VecTest.hs:32:5) >> ys :: Vec a m (bound at VecTest.hs:25:12) >> gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) >> (bound at VecTest.hs:25:1) >> In the second argument of ?gfold?, namely ?f? >> In the expression: gfold p f ys xs >> >> VecTest.hs:25:27: >> Couldn't match type ?m? with ?'Z? >> ?m? is a rigid type variable bound by >> the type signature for >> gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) >> at VecTest.hs:24:21 >> Expected type: Vec a 'Z >> Actual type: Vec a m >> Relevant bindings include >> p :: Proxy (P a m) (bound at VecTest.hs:28:5) >> f :: forall (l :: Nat). >> Proxy l -> a -> Vec a (Plus l m) -> Vec a ('S (Plus l m)) >> (bound at VecTest.hs:32:5) >> ys :: Vec a m (bound at VecTest.hs:25:12) >> gconcat :: Vec a n -> Vec a m -> Vec a (Plus n m) >> (bound at VecTest.hs:25:1) >> In the third argument of ?gfold?, namely ?ys? >> In the expression: gfold p f ys xs > > Is this kind of type-level programming just not yet possible in GHC? > Or am I simply doing it wrong? > > Cheers, > > Christiaan > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From christiaan.baaij at gmail.com Wed Nov 19 15:25:21 2014 From: christiaan.baaij at gmail.com (Christiaan Baaij) Date: Wed, 19 Nov 2014 16:25:21 +0100 Subject: [Haskell-cafe] Dependently typed fold in GHC/Haskell In-Reply-To: <0E08A7C9-650D-4809-975F-0AFD15228557@cis.upenn.edu> References: <0E08A7C9-650D-4809-975F-0AFD15228557@cis.upenn.edu> Message-ID: <68BCAD8E-AA93-45EE-9706-892039BF40F9@gmail.com> On Nov 19, 2014, at 3:59 PM, Richard Eisenberg wrote: > You were really close, but there was a big leap that you would have to take before this would work. The fundamental problem is that you tried to use the `P` type family only partially applied. GHC does not allow partially-applied type functions. It is a bug in GHC 7.8.3 that no clear error is reported when you try to do so -- it is better in previous and later versions. (Specifically, I'm looking at the use of `P` in the type signature for `p` within `gconcat`.) On Nov 19, 2014, at 3:37 PM, Andres L?h wrote: > Hi. > > You cannot partially apply a type family, as you try in > >>> type family P (a :: *) (m :: Nat) (l :: Nat) :: * where >>> P a m l = Vec a (Plus l m) Thank you very much for not only pointing out my mistake, but also providing a solution! :-D Finally I can convert some of my list code to fixed-size vector code. Cheers, Christiaan From R.Paterson at city.ac.uk Wed Nov 19 16:45:56 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Wed, 19 Nov 2014 16:45:56 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: References: Message-ID: <20141119164556.GA5245@city.ac.uk> On Tue, Nov 18, 2014 at 04:49:23PM -0500, David Feuer wrote: > I'd like to define (*>) and (>>) for Data.Seq.Seq in a "clever" way, > like replicate, but I'm a bit stuck. It kind of looks like this is the > purpose behind the applicativeTree function, which bills itself as a > generalization of replicateA, but something seems to have gotten stuck > and the only time I see applicativeTree actually used is to define > replicateA. With all the fancy nesting, I'm a bit lost as to how to > go about this, and having only one example doesn't really help. Can > someone help give me a clue? I don't think applicativeTree will do the job -- it assumes the argument is a 2-3 tree (not a finger tree). The best I can think of is xs *> ys = replicateSeq (Seq.length xs) ys -- Concatenate n copies of xs replicateSeq :: Int -> Seq a -> Seq a replicateSeq n xs | n == 0 = empty | even n = nxs | otherwise = xs >< nxs where nxs = replicateSeq (n `div` 2) (xs >< xs) I think it's O(log m*(log m + log n)), where m and n are the lengths of the two sequences, which is certainly an improvement on O(mn). Another way of doing replicateSeq would be replicateSeq :: Int -> Seq a -> Seq a replicateSeq n xs | n == 0 = empty | even n = half >< half | otherwise = xs >< half >< half where half = replicateSeq (n `div` 2) xs I'm not sure which would give the most sharing. From matteo.ferrando2 at gmail.com Wed Nov 19 17:38:51 2014 From: matteo.ferrando2 at gmail.com (Matteo Ferrando) Date: Wed, 19 Nov 2014 13:08:51 -0430 Subject: [Haskell-cafe] Parsing error in Haskell2010 In-Reply-To: <546CA174.4030000@ro-che.info> References: <99466A8E-887B-435D-8F71-E6F5F4DAF03F@cs.uchicago.edu> <546CA174.4030000@ro-che.info> Message-ID: Stuart, As Roman says, GHC is expecting that everything in that indentation level will be a new binding, that's te reason of giving the error *on the next line*, is because it was still *looking* for a `=` when it found `report`. As of why Haskell2010 changed this behaviour, I have no idea, but I'm sure the people behind this had good reasons (I find Haskell2010's behaviour more desirable). You can always use the `NondecreasingIndentation` suggested by Roman. Cheers, Matteo On Wed, Nov 19, 2014 at 9:26 AM, Roman Cheplyaka wrote: > The first lexeme after let is log. Everything indented same as log (that > is, starting at the same column as log) is considered to be bindings > inside that let; everything indented more is considered to be > continuation of a binding. > > In your original example, initialize is indented same as log, so ghc > tries to parse it as a binding, and fails. > > The NondecreasingIndentation that I mentioned in the other email relaxes > this constraint. > > On 19/11/14 14:45, Stuart A. Kurtz wrote: > > Dear Matteo, > > > > The surprise for me comes from the idea that the *amount* of indentation > matters on establishing a new block, which hasn't been my experience with > Haskell's offside rule before, although I tend to be 4-ist when it comes to > indenting, and it's possible that this behavior has kept me on the good > side thus far of rules that I wasn't aware of. > > > > So my instinct would have been to indent the code the way you've done > below, but only if there were additional let bindings. It is particularly > confusing that the error is reported as being on the "report" line, which > seems to imply that the indentation of the previous line was ok (and > therefore that the implicit block of which it is a part had been set up > based on the do). It's nothing new to see syntax errors reported a line > late -- the Pascal compilers did that! -- but unexpected here because GHC > seems quite good about locating errors. > > > > Peace, > > > > Stu > > > > > >> On Nov 18, 2014, at 11:16 PM, Matteo Ferrando < > matteo.ferrando2 at gmail.com> wrote: > >> > >>> This seems to be the issue. Haskell98 didn't require this, Haskell2010 > does, and this seems less desirable to me. Isn't it reasonable to assume > that the it's the do that dominates syntactically here, and not the let? > >> > >> No, so you can do stuff like: > >> > >> main = do > >> gen <- getStdGen > >> let log = runModel gen $ do > >> initialize 72 > >> report > >> replicateM_ 50 $ do > >> replicateM_251 migrate > >> report > >> log' = runModel gen $ do > >> initialize 42 > >> report > >> replicateM_ 50 $ do > >> replicateM_251 migrate > >> report > >> log'' = runModel gen $ do > >> initialize 42 > >> report > >> replicateM_ 50 $ do > >> replicateM_251 migrate > >> report > >> putStr . format $ log > >> putStr . format $ log' > >> putStr . format $ log'' > >> > >> Defining `log`, `log'` and `log''` with the same `let`. > >> > >> Cheers, > >> > >> Matteo > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Wed Nov 19 18:05:13 2014 From: david.feuer at gmail.com (David Feuer) Date: Wed, 19 Nov 2014 13:05:13 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141119164556.GA5245@city.ac.uk> References: <20141119164556.GA5245@city.ac.uk> Message-ID: Many thanks. I don't *think* it's ever been as bad as O(mn) (I'm pretty sure it's no worse than O(m log m log n) and it may well be better), but it's certainly not great for time and it's definitely not great for space. I believe both of your versions are essentially based on fast exponentiation, which was going to be my fall-back position barring something more magically good taking advantage of the tree structure somehow. I know there are some fancy versions of fast exponentiation to minimize multiplications, but any version thereof would be better than the current approach. On Wed, Nov 19, 2014 at 11:45 AM, Ross Paterson wrote: > On Tue, Nov 18, 2014 at 04:49:23PM -0500, David Feuer wrote: > > I'd like to define (*>) and (>>) for Data.Seq.Seq in a "clever" way, > > like replicate, but I'm a bit stuck. It kind of looks like this is the > > purpose behind the applicativeTree function, which bills itself as a > > generalization of replicateA, but something seems to have gotten stuck > > and the only time I see applicativeTree actually used is to define > > replicateA. With all the fancy nesting, I'm a bit lost as to how to > > go about this, and having only one example doesn't really help. Can > > someone help give me a clue? > > I don't think applicativeTree will do the job -- it assumes the argument > is a 2-3 tree (not a finger tree). The best I can think of is > > xs *> ys = replicateSeq (Seq.length xs) ys > > -- Concatenate n copies of xs > replicateSeq :: Int -> Seq a -> Seq a > replicateSeq n xs > | n == 0 = empty > | even n = nxs > | otherwise = xs >< nxs > where nxs = replicateSeq (n `div` 2) (xs >< xs) > > I think it's O(log m*(log m + log n)), where m and n are the lengths of > the two sequences, which is certainly an improvement on O(mn). > > Another way of doing replicateSeq would be > > replicateSeq :: Int -> Seq a -> Seq a > replicateSeq n xs > | n == 0 = empty > | even n = half >< half > | otherwise = xs >< half >< half > where half = replicateSeq (n `div` 2) xs > > I'm not sure which would give the most sharing. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg at gregorycollins.net Wed Nov 19 18:30:23 2014 From: greg at gregorycollins.net (Gregory Collins) Date: Wed, 19 Nov 2014 10:30:23 -0800 Subject: [Haskell-cafe] Space leak in WAI 3.0 application In-Reply-To: References: Message-ID: On Tue, Nov 18, 2014 at 4:59 PM, Thomas Koster wrote: > Why does version A not process the LBS in constant space? > The lazy bytestring is let-lifted out of the function so that subsequent calls reuse the same heap value. > What in version A is preventing the GC from collecting the LBS chunks > after they have been fed to Warp? > The value is re-used (and the closure holds a reference) so the GC can't collect it. What is it about version B that permits the LBS chunks to be collected? > The allocation is performed underneath the lambda in version B and so you get a fresh copy every time. G -- Gregory Collins -------------- next part -------------- An HTML attachment was scrubbed... URL: From twilson at csufresno.edu Wed Nov 19 18:37:54 2014 From: twilson at csufresno.edu (Todd Wilson) Date: Wed, 19 Nov 2014 10:37:54 -0800 Subject: [Haskell-cafe] Forcing recomputation In-Reply-To: References: <20141119075502.GI17876@weber> Message-ID: Thanks, Chris and Tom, your posts contained exactly what I was looking for. --Todd Todd Wilson, PhD Department of Computer Science California State University, Fresno On Tue, Nov 18, 2014 at 11:58 PM, Christopher Allen wrote: > Looks like > http://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Exception.html#g:8 > ? > > https://github.com/bos/criterion/blob/master/Criterion/Types.hs#L290-L295 > > On Wed, Nov 19, 2014 at 1:55 AM, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > >> On Tue, Nov 18, 2014 at 11:39:37PM -0800, Todd Wilson wrote: >> > For example, suppose I have a function f and two arguments e1 >> > and e2, and I want to compare the time it takes to compute f e1 vs. f >> > e2 >> >> If your purpose is benchmarking (and even if it isn't) I suggest you look >> at >> how criterion manages the issue >> >> http://www.serpentine.com/criterion/tutorial.html >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From R.Paterson at city.ac.uk Wed Nov 19 18:50:04 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Wed, 19 Nov 2014 18:50:04 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: References: <20141119164556.GA5245@city.ac.uk> Message-ID: <20141119185004.GA5915@city.ac.uk> On Wed, Nov 19, 2014 at 01:05:13PM -0500, David Feuer wrote: > Many thanks. I don't *think* it's ever been as bad as O(mn) (I'm pretty > sure it's no worse than O(m log m log n) and it may well be better), Oh right, there are m appends, each O(log n). From david.feuer at gmail.com Wed Nov 19 18:53:02 2014 From: david.feuer at gmail.com (David Feuer) Date: Wed, 19 Nov 2014 13:53:02 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141119185004.GA5915@city.ac.uk> References: <20141119164556.GA5245@city.ac.uk> <20141119185004.GA5915@city.ac.uk> Message-ID: I meant O(m log (mn)) = O(m (log m + log n)), because there are m appends, building up from O(n) to O(mn), but it really doesn't matter because we can easily do better. On Wed, Nov 19, 2014 at 1:50 PM, Ross Paterson wrote: > On Wed, Nov 19, 2014 at 01:05:13PM -0500, David Feuer wrote: > > Many thanks. I don't *think* it's ever been as bad as O(mn) (I'm pretty > > sure it's no worse than O(m log m log n) and it may well be better), > > Oh right, there are m appends, each O(log n). > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From R.Paterson at city.ac.uk Wed Nov 19 19:02:08 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Wed, 19 Nov 2014 19:02:08 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: References: <20141119164556.GA5245@city.ac.uk> <20141119185004.GA5915@city.ac.uk> Message-ID: <20141119190208.GA6047@city.ac.uk> On Wed, Nov 19, 2014 at 01:53:02PM -0500, David Feuer wrote: > I meant O(m log (mn)) = O(m (log m + log n)), because there are m appends, > building up from O(n) to O(mn), but it really doesn't matter because we can > easily do better. Indeed it's moot, but appending a tree of size n to one of size mn costs O(log n). From david.feuer at gmail.com Wed Nov 19 19:58:46 2014 From: david.feuer at gmail.com (David Feuer) Date: Wed, 19 Nov 2014 14:58:46 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141119190208.GA6047@city.ac.uk> References: <20141119164556.GA5245@city.ac.uk> <20141119185004.GA5915@city.ac.uk> <20141119190208.GA6047@city.ac.uk> Message-ID: On Wed, Nov 19, 2014 at 2:02 PM, Ross Paterson wrote: > On Wed, Nov 19, 2014 at 01:53:02PM -0500, David Feuer wrote: > > I meant O(m log (mn)) = O(m (log m + log n)), because there are m > appends, > > building up from O(n) to O(mn), but it really doesn't matter because we > can > > easily do better. > > Indeed it's moot, but appending a tree of size n to one of size mn > costs O(log n). > Right, I forgot that. I got to looking at <*> just now, and it suggests the following question: is there a particularly efficient way to build a Seq when its ultimate size is known in advance, avoiding the usual incremental rebuilding? -------------- next part -------------- An HTML attachment was scrubbed... URL: From tdammers at gmail.com Wed Nov 19 20:42:10 2014 From: tdammers at gmail.com (Tobias Dammers) Date: Wed, 19 Nov 2014 21:42:10 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <546CAD11.1030209@power.com.pl> References: <20141119084629.B5594C3841@www1.g3.pair.com> <546C7CBC.7070309@power.com.pl> <20141119121735.GB24596@nibbler> <546CAD11.1030209@power.com.pl> Message-ID: <20141119204207.GB27557@yemaya> On Wed, Nov 19, 2014 at 03:45:37PM +0100, Wojtek Narczy?ski wrote: > On 19.11.2014 13:17, Tobias Dammers wrote: > >That's pretty much what my tamper library > >(http://hackage.haskell.org/package/tamper) is supposed to be. It's > >pretty rough around the edges still, and nowhere near as complete as > >Blaze itself, but it works well enough for basic HTML templating, and > >unlike Blaze, it is implemented as a monad transformer, which means you > >can integrate it with whatever monad stack you like. I couldn't find an > >existing solution to this myself, which is why I rolled my own. > Tobias, > > > I'm puzzled how your library can ensure that, for example has only > one , how / where are such rules enforced? Do you have a sample or > testcase? Ah, sorry for getting your hopes up. No, it doesn't ensure valid parent/child combinations or anything, it just does what basic Blaze-HTML does, but generalized to a monad transformer. I considered writing something that could do this, but figured that 1) it would be pretty tricky to get right, and 2) it would be quite restricting, for little gain. The kind of incorrectness this would prevent isn't that common, and when it does happen, it rarely causes severe breakage, meanwhile locking things down would make it harder to adapt your code to the moving target that is HTML. So I dropped the idea. One thing I might want at some point though is checking for valid attributes, somehow. Not sure how to go about that yet though, not without going completely crazy with types, anyway. > > > On the practical side, wouldn't you prefer to write, for example? > > {-#LANGUAGE Rank2Types #-} > > type ElementType = (Monad m, Ord t, IsString t) => TamperT t m () -> TamperT > t m () > > a, abbr, address, area, article, aside, audio :: ElementType > a = tag "a" > abbr = tag "abbr" > address = tag "address" > area = tagS "area" > article = tag "article" > aside = tag "aside" > audio = tag "audio" Good point; patches welcome in case I forget doing it myself ;) From R.Paterson at city.ac.uk Thu Nov 20 00:37:49 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Thu, 20 Nov 2014 00:37:49 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> References: <CAMgWh9vksUPuxJMHRmuQzH1iaeAZc5mPvrXOwUJ40GrdUxVezA@mail.gmail.com> <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> Message-ID: <20141120003749.GA7412@city.ac.uk> On Wed, Nov 19, 2014 at 02:58:46PM -0500, David Feuer wrote: > I got to looking at <*> just now, and it suggests the > following question: is there a particularly efficient way to build a Seq when > its ultimate size is known in advance, avoiding the usual incremental > rebuilding? The following avoids the rebuilding, but I haven't tweaked or timed it: fromList' :: [a] -> Seq a fromList' xs = Seq $ mkTree (Data.List.length xs) 1 $ map Elem xs mkTree :: Int -> Int -> [a] -> FingerTree a mkTree n size xs | n == 0 = Empty | n == 1 = let [x1] = xs in Single x1 | n < 6 = let (l, r) = Data.List.splitAt (n `div` 2) xs in Deep totalSize (mkDigit l) Empty (mkDigit r) | otherwise = let size' = 3*size n' = (n-4) `div` 3 digits = n - n'*3 (l, rest) = Data.List.splitAt (digits `div` 2) xs (nodes, r) = getNodes n' size' rest in Deep totalSize (mkDigit l) (mkTree n' size' nodes) (mkDigit r) where totalSize = n*size mkDigit :: [a] -> Digit a mkDigit [x1] = One x1 mkDigit [x1, x2] = Two x1 x2 mkDigit [x1, x2, x3] = Three x1 x2 x3 mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4 getNodes :: Int -> Int -> [a] -> ([Node a], [a]) getNodes n _ xs | n == 0 = ([], xs) getNodes n size (x1:x2:x3:xs) = (Node3 size x1 x2 x3:ns, ys) where (ns, ys) = getNodes (n-1) size xs From david.feuer at gmail.com Thu Nov 20 01:26:51 2014 From: david.feuer at gmail.com (David Feuer) Date: Wed, 19 Nov 2014 20:26:51 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141120003749.GA7412@city.ac.uk> References: <CAMgWh9vksUPuxJMHRmuQzH1iaeAZc5mPvrXOwUJ40GrdUxVezA@mail.gmail.com> <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> Message-ID: <CAMgWh9sttvN0fYiBH7XywkaumW-+fF4B-ButFKnfAF-vjn0mYQ@mail.gmail.com> On Nov 19, 2014 7:38 PM, "Ross Paterson" <R.Paterson at city.ac.uk> wrote: > > On Wed, Nov 19, 2014 at 02:58:46PM -0500, David Feuer wrote: > > I got to looking at <*> just now, and it suggests the > > following question: is there a particularly efficient way to build a Seq when > > its ultimate size is known in advance, avoiding the usual incremental > > rebuilding? > > The following avoids the rebuilding, but I haven't tweaked or timed it: I don't know how well this will work for fromList, but it looks like it will almost certainly be good for <*> and *>. I'll try it out. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141119/bf23ad07/attachment.html> From dstcruz at gmail.com Thu Nov 20 04:27:17 2014 From: dstcruz at gmail.com (Daniel Santa Cruz) Date: Wed, 19 Nov 2014 21:27:17 -0700 Subject: [Haskell-cafe] Haskell Weekly News: Issue 312 Message-ID: <CA+V-9CyWsto4ZMgPdyFOVZGpsent9kwnjLJsmt7D4xtY3Ceqxw@mail.gmail.com> Welcome to issue 312 of the HWN, an issue covering crowd-sourced bits of information about Haskell from around the web. This issue covers from October 26 to November 15, 2014 Quotes of the Week * barsoap: There's no place for half measures in overkill. Top Reddit Stories * Category Theory for Programmers: The Preface Domain: bartoszmilewski.com, Score: 141, Comments: 68 Original: [1] http://goo.gl/nTaVM5 On Reddit: [2] http://goo.gl/9cnWqN * Idris 0.9.15 released: partial evaluator, uniqueness types, library cleanups, and fancier docs. Domain: idris-lang.org, Score: 111, Comments: 55 Original: [3] http://goo.gl/nL9Ptr On Reddit: [4] http://goo.gl/mkHVEl * HaskForce - The Haskell Plugin for IntelliJ IDEA Domain: carymrobbins.github.io, Score: 104, Comments: 34 Original: [5] http://goo.gl/Oa0jBA On Reddit: [6] http://goo.gl/W2jrFW * Haskell for all: How to desugar Haskell code Domain: haskellforall.com, Score: 97, Comments: 50 Original: [7] http://goo.gl/1ZfiyP On Reddit: [8] http://goo.gl/hK3xTo * Functional programming and condescension Domain: superginbaby.wordpress.com, Score: 87, Comments: 147 Original: [9] http://goo.gl/erVkNx On Reddit: [10] http://goo.gl/ncQcxX * Quick Reminder to be Courteous Domain: self.haskell, Score: 85, Comments: 39 Original: [11] http://goo.gl/pmEODB On Reddit: [12] http://goo.gl/pmEODB * Category Theory Applied to Functional Programming Domain: eafit.edu.co, Score: 84, Comments: 14 Original: [13] http://goo.gl/ax59vm On Reddit: [14] http://goo.gl/xZYksD * New Book - Game Programming in Haskell Domain: leanpub.com, Score: 84, Comments: 31 Original: [15] http://goo.gl/hAqaaU On Reddit: [16] http://goo.gl/XePpcJ * "hasql" is up to 2x and 7x faster than "postgresql-simple" and "HDBC" Domain: nikita-volkov.github.io, Score: 72, Comments: 22 Original: [17] http://goo.gl/YwU4OQ On Reddit: [18] http://goo.gl/fnfFAC * Typing Haskell in Haskell (markdownified with syntax highlighting and updated links) Domain: gist.github.com, Score: 68, Comments: 3 Original: [19] http://goo.gl/U6Jnvr On Reddit: [20] http://goo.gl/QeLcak * Using Haskell at Work Domain: self.haskell, Score: 66, Comments: 66 Original: [21] http://goo.gl/265kRm On Reddit: [22] http://goo.gl/265kRm * Category: The Essence of Composition (First section of the Category Theory for Programmers?) Domain: bartoszmilewski.com, Score: 60, Comments: 37 Original: [23] http://goo.gl/pdwr4X On Reddit: [24] http://goo.gl/AtYhI3 * PureScript 0.6 released, plus new website Domain: github.com, Score: 55, Comments: 23 Original: [25] http://goo.gl/TSuiEM On Reddit: [26] http://goo.gl/ZRBCHz * Tomatoes are a subtype of vegetables Domain: blog.ezyang.com, Score: 53, Comments: 58 Original: [27] http://goo.gl/1evzHU On Reddit: [28] http://goo.gl/qiiwSS * The Guts of a Spineless Machine Domain: jozefg.bitbucket.org, Score: 49, Comments: 11 Original: [29] http://goo.gl/KxW1iq On Reddit: [30] http://goo.gl/CNQbwk * A Large Scale Study of Programming Languages and Code Quality in Github Domain: macbeth.cs.ucdavis.edu, Score: 47, Comments: 48 Original: [31] http://goo.gl/TEoSBV On Reddit: [32] http://goo.gl/18UfCM * ghci-ng - GHCi plus extra goodies Domain: github.com, Score: 45, Comments: 14 Original: [33] http://goo.gl/g6VMiK On Reddit: [34] http://goo.gl/5Mg7n8 Top StackOverflow Questions * Haskell's type checker is allowing a very wrong type replacement, and the program still compiles votes: 68, answers: 2 Read on SO: [35] http://goo.gl/ikcCmv * Subsumption in polymorphic types votes: 29, answers: 1 Read on SO: [36] http://goo.gl/clKuju * Rewriting as a practical optimization technique in GHC: Is it really needed? votes: 23, answers: 3 Read on SO: [37] http://goo.gl/MNNuhW * Is there an unsigned integer type that will warn about negative literals? votes: 21, answers: 1 Read on SO: [38] http://goo.gl/SmRO3t * How can I make GHCI release memory votes: 19, answers: 1 Read on SO: [39] http://goo.gl/U3qroZ * How much of Pascal's triangle does this evaluate? votes: 15, answers: 1 Read on SO: [40] http://goo.gl/PsaQ3X * Why is super-compilation not implemented more prevalent? votes: 14, answers: 3 Read on SO: [41] http://goo.gl/MFNsrE Until next time, [42]+Daniel Santa Cruz References 1. http://bartoszmilewski.com/2014/10/28/category-theory-for-programmers-the-preface/ 2. http://www.reddit.com/r/haskell/comments/2kkrd3/category_theory_for_programmers_the_preface/ 3. http://www.idris-lang.org/idris-0-9-15-released/ 4. http://www.reddit.com/r/haskell/comments/2kfosg/idris_0915_released_partial_evaluator_uniqueness/ 5. http://carymrobbins.github.io/intellij-haskforce/ 6. http://www.reddit.com/r/haskell/comments/2kvzuz/haskforce_the_haskell_plugin_for_intellij_idea/ 7. http://www.haskellforall.com/2014/10/how-to-desugar-haskell-code.html 8. http://www.reddit.com/r/haskell/comments/2kf61f/haskell_for_all_how_to_desugar_haskell_code/ 9. http://superginbaby.wordpress.com/2014/10/28/suddenly-the-opposite-appeared/ 10. http://www.reddit.com/r/haskell/comments/2klj3b/functional_programming_and_condescension/ 11. http://www.reddit.com/r/haskell/comments/2lfofw/quick_reminder_to_be_courteous/ 12. http://www.reddit.com/r/haskell/comments/2lfofw/quick_reminder_to_be_courteous/ 13. http://www1.eafit.edu.co/asicard/pubs/cain-screen.pdf 14. http://www.reddit.com/r/haskell/comments/2kowzu/category_theory_applied_to_functional_programming/ 15. https://leanpub.com/gameinhaskell 16. http://www.reddit.com/r/haskell/comments/2m253y/new_book_game_programming_in_haskell/ 17. http://nikita-volkov.github.io/hasql-benchmarks/ 18. http://www.reddit.com/r/haskell/comments/2lwx9y/hasql_is_up_to_2x_and_7x_faster_than/ 19. https://gist.github.com/chrisdone/0075a16b32bfd4f62b7b 20. http://www.reddit.com/r/haskell/comments/2lo881/typing_haskell_in_haskell_markdownified_with/ 21. http://www.reddit.com/r/haskell/comments/2lcx8c/using_haskell_at_work/ 22. http://www.reddit.com/r/haskell/comments/2lcx8c/using_haskell_at_work/ 23. http://bartoszmilewski.com/2014/11/04/category-the-essence-of-composition/ 24. http://www.reddit.com/r/haskell/comments/2la0cx/category_the_essence_of_composition_first_section/ 25. https://github.com/purescript/purescript/releases/tag/v0.6.0 26. http://www.reddit.com/r/haskell/comments/2lt7oc/purescript_06_released_plus_new_website/ 27. http://blog.ezyang.com/2014/11/tomatoes-are-a-subtype-of-vegetables/ 28. http://www.reddit.com/r/haskell/comments/2meyxf/tomatoes_are_a_subtype_of_vegetables/ 29. http://jozefg.bitbucket.org/posts/2014-10-28-stg.html 30. http://www.reddit.com/r/haskell/comments/2kswnp/the_guts_of_a_spineless_machine/ 31. http://macbeth.cs.ucdavis.edu/lang_study.pdf 32. http://www.reddit.com/r/haskell/comments/2lb3oz/a_large_scale_study_of_programming_languages_and/ 33. https://github.com/chrisdone/ghci-ng 34. http://www.reddit.com/r/haskell/comments/2l9bvb/ghcing_ghci_plus_extra_goodies/ 35. http://stackoverflow.com/questions/26770247/haskells-type-checker-is-allowing-a-very-wrong-type-replacement-and-the-progra 36. http://stackoverflow.com/questions/26806653/subsumption-in-polymorphic-types 37. http://stackoverflow.com/questions/26827663/rewriting-as-a-practical-optimization-technique-in-ghc-is-it-really-needed 38. http://stackoverflow.com/questions/26574302/is-there-an-unsigned-integer-type-that-will-warn-about-negative-literals 39. http://stackoverflow.com/questions/26712188/how-can-i-make-ghci-release-memory 40. http://stackoverflow.com/questions/26729146/how-much-of-pascals-triangle-does-this-evaluate 41. http://stackoverflow.com/questions/26605431/why-is-super-compilation-not-implemented-more-prevalent 42. https://plus.google.com/105107667630152149014/about -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141119/8f6153c6/attachment.html> From tkoster at gmail.com Thu Nov 20 04:40:06 2014 From: tkoster at gmail.com (Thomas Koster) Date: Thu, 20 Nov 2014 15:40:06 +1100 Subject: [Haskell-cafe] Space leak in WAI 3.0 application In-Reply-To: <CAHZrzdqE-HpnkZxDSO-tGwtJsyFJY8Qo7NBfLFb3yuw2Z8+AxA@mail.gmail.com> References: <CAG1wH7Abg4V_rfQ6GNoyGrDPcAYJP3q6TZSr=jLgdNzgnagZoA@mail.gmail.com> <CAHZrzdqE-HpnkZxDSO-tGwtJsyFJY8Qo7NBfLFb3yuw2Z8+AxA@mail.gmail.com> Message-ID: <CAG1wH7DbYB9egW+6vD77LS-oXiGgzj3CHJXY_iS9jNjumLUj7w@mail.gmail.com> On Tue, Nov 18, 2014 at 4:59 PM, Thomas Koster <tkoster at gmail.com> wrote: > -- | This version has a space leak. > zerosAppA :: Application > zerosAppA _req respond = > withZeros 100000000 $ \ largeLBS -> > respond $ responseStream status200 [] $ \ write _flush -> > write $ fromLazyByteString largeLBS > > -- | This version does not have a space leak. > zerosAppB :: Application > zerosAppB _req respond = > respond $ responseStream status200 [] $ \ write _flush -> > withZeros 100000000 $ \ largeLBS -> > write $ fromLazyByteString largeLBS On 20 November 2014 05:30, Gregory Collins <greg at gregorycollins.net> wrote: >> Why does version A not process the LBS in constant space? > > The lazy bytestring is let-lifted out of the function so that subsequent > calls reuse the same heap value. > >> What in version A is preventing the GC from collecting the LBS chunks >> after they have been fed to Warp? > > The value is re-used (and the closure holds a reference) so the GC can't > collect it. > >> What is it about version B that permits the LBS chunks to be collected? > > The allocation is performed underneath the lambda in version B and so you > get a fresh copy every time. Thanks for your reply. My coding style makes heavy use of let to keep lines succinct so am I going to have to be more careful about the order of lets in case I accidentally introduce unwanted sharing? I was able to re-arrange the leaky version A into version B in my example, but I may not be able to do this in my real application. What if I need the first few bytes of "largeLBS" to determine the response status code or headers? This is only possible in version A. Or will replacing the lazy bytestring with a streaming abstraction like pipes or conduit make the problem go away in both versions? Thanks, -- Thomas Koster From spam at scientician.net Thu Nov 20 05:59:47 2014 From: spam at scientician.net (Bardur Arantsson) Date: Thu, 20 Nov 2014 06:59:47 +0100 Subject: [Haskell-cafe] Space leak in WAI 3.0 application In-Reply-To: <CAG1wH7DbYB9egW+6vD77LS-oXiGgzj3CHJXY_iS9jNjumLUj7w@mail.gmail.com> References: <CAG1wH7Abg4V_rfQ6GNoyGrDPcAYJP3q6TZSr=jLgdNzgnagZoA@mail.gmail.com> <CAHZrzdqE-HpnkZxDSO-tGwtJsyFJY8Qo7NBfLFb3yuw2Z8+AxA@mail.gmail.com> <CAG1wH7DbYB9egW+6vD77LS-oXiGgzj3CHJXY_iS9jNjumLUj7w@mail.gmail.com> Message-ID: <m4k00j$941$1@ger.gmane.org> On 2014-11-20 05:40, Thomas Koster wrote: > > Thanks for your reply. > > My coding style makes heavy use of let to keep lines succinct so am I > going to have to be more careful about the order of lets in case I > accidentally introduce unwanted sharing? > > I was able to re-arrange the leaky version A into version B in my > example, but I may not be able to do this in my real application. What > if I need the first few bytes of "largeLBS" to determine the response > status code or headers? This is only possible in version A. > I would recommend avoiding lazy I/O altogether and using "responseStream" instead. This will let you decide exactly what to write and when. > Or will replacing the lazy bytestring with a streaming abstraction > like pipes or conduit make the problem go away in both versions? Not magically, but both of those can certainly be used to avoid the problem. You'll still have to arrange it so that you don't close over a huge (lazy) byte string. If what you're trying to do is simple, then I'd just recommend writing your responses using "responseStream" and writing your "genereate output" function in terms of the "write" and "flush" callbacks you get access to write "responseStream". It's pretty easy when you get the hang of it. Regards, From tkoster at gmail.com Thu Nov 20 07:29:34 2014 From: tkoster at gmail.com (Thomas Koster) Date: Thu, 20 Nov 2014 18:29:34 +1100 Subject: [Haskell-cafe] Space leak in WAI 3.0 application In-Reply-To: <m4k00j$941$1@ger.gmane.org> References: <CAG1wH7Abg4V_rfQ6GNoyGrDPcAYJP3q6TZSr=jLgdNzgnagZoA@mail.gmail.com> <CAHZrzdqE-HpnkZxDSO-tGwtJsyFJY8Qo7NBfLFb3yuw2Z8+AxA@mail.gmail.com> <CAG1wH7DbYB9egW+6vD77LS-oXiGgzj3CHJXY_iS9jNjumLUj7w@mail.gmail.com> <m4k00j$941$1@ger.gmane.org> Message-ID: <CAG1wH7CSfexaAFPe4i5SrGfdp6tPoQe=bFrARGvU2y6W=4SEjg@mail.gmail.com> On Tue, Nov 18, 2014 at 4:59 PM, Thomas Koster <tkoster at gmail.com> wrote: > -- | This version has a space leak. > zerosAppA :: Application > zerosAppA _req respond = > withZeros 100000000 $ \ largeLBS -> > respond $ responseStream status200 [] $ \ write _flush -> > write $ fromLazyByteString largeLBS > > -- | This version does not have a space leak. > zerosAppB :: Application > zerosAppB _req respond = > respond $ responseStream status200 [] $ \ write _flush -> > withZeros 100000000 $ \ largeLBS -> > write $ fromLazyByteString largeLBS On 20 November 2014 16:59, Bardur Arantsson <spam at scientician.net> wrote: > I would recommend avoiding lazy I/O altogether and using > "responseStream" instead. This will let you decide exactly what to write > and when. I am already using responseStream. It's just that in my examples and my real application, the 'octets' to be used for the response entity ("largeLBS" from my examples) are provided to the callback as a lazy bytestring built from lazy I/O, until I get my head around pipes and conduit. >> Or will replacing the lazy bytestring with a streaming abstraction >> like pipes or conduit make the problem go away in both versions? > > Not magically, but both of those can certainly be used to avoid the > problem. You'll still have to arrange it so that you don't close over > a huge (lazy) byte string. OK, but could I use pipes or conduit (no lazy I/O) to remove the space leak in version A without transforming it into version B (which doesn't have the space leak anyway)? That is, can I switch out the lazy bytestring in version A with a pipe or conduit so that I can start streaming the zeros *outside* of responseStream in order to determine the HTTP status code and headers (which is only possible in version A) and continue to stream them *inside* of responseStream for the rest of the response entity, without incurring a space leak? If the answer is "yes" then that's that and I will go and learn pipes and/or conduit right away. > If what you're trying to do is simple, then I'd just recommend writing > your responses using "responseStream" and writing your "genereate > output" function in terms of the "write" and "flush" callbacks you get > access to write "responseStream". It's pretty easy when you get the hang > of it. ...except that the HTTP status code and headers are arguments to responseStream and therefore I cannot determine them from within the callback passed as responseStream's third argument. This is why some of my 'long stream' needs to be accessed before invoking responseStream and why my real application looks like the leaky version A. Thanks, -- Thomas Koster From roma at ro-che.info Thu Nov 20 09:37:52 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Thu, 20 Nov 2014 11:37:52 +0200 Subject: [Haskell-cafe] Forcing recomputation In-Reply-To: <CADnndOqFXxKn2gN2RB0Kj9iNnLOwpHDSKa7NWeL8EkSuLu9K6Q@mail.gmail.com> References: <CA+-99oLi+zZCxRh_D6_A-srTxr+0mM-yUu4CrD6TW61T8ktpoA@mail.gmail.com> <20141119075502.GI17876@weber> <CADnndOqFXxKn2gN2RB0Kj9iNnLOwpHDSKa7NWeL8EkSuLu9K6Q@mail.gmail.com> Message-ID: <546DB670.9060708@ro-che.info> Control.Exception.evaluate doesn't have much to do with forcing recomputation. If the argument is already in whnf, evaluate won't do anything. On 19/11/14 09:58, Christopher Allen wrote: > Looks > like http://hackage.haskell.org/package/base-4.7.0.1/docs/Control-Exception.html#g:8 > ? > > https://github.com/bos/criterion/blob/master/Criterion/Types.hs#L290-L295 > > On Wed, Nov 19, 2014 at 1:55 AM, Tom Ellis > <tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk > <mailto:tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk>> wrote: > > On Tue, Nov 18, 2014 at 11:39:37PM -0800, Todd Wilson wrote: > > For example, suppose I have a function f and two arguments e1 > > and e2, and I want to compare the time it takes to compute f e1 vs. f > > e2 > > If your purpose is benchmarking (and even if it isn't) I suggest you > look at > how criterion manages the issue > > http://www.serpentine.com/criterion/tutorial.html From spam at scientician.net Thu Nov 20 09:42:41 2014 From: spam at scientician.net (Bardur Arantsson) Date: Thu, 20 Nov 2014 10:42:41 +0100 Subject: [Haskell-cafe] Space leak in WAI 3.0 application In-Reply-To: <CAG1wH7CSfexaAFPe4i5SrGfdp6tPoQe=bFrARGvU2y6W=4SEjg@mail.gmail.com> References: <CAG1wH7Abg4V_rfQ6GNoyGrDPcAYJP3q6TZSr=jLgdNzgnagZoA@mail.gmail.com> <CAHZrzdqE-HpnkZxDSO-tGwtJsyFJY8Qo7NBfLFb3yuw2Z8+AxA@mail.gmail.com> <CAG1wH7DbYB9egW+6vD77LS-oXiGgzj3CHJXY_iS9jNjumLUj7w@mail.gmail.com> <m4k00j$941$1@ger.gmane.org> <CAG1wH7CSfexaAFPe4i5SrGfdp6tPoQe=bFrARGvU2y6W=4SEjg@mail.gmail.com> Message-ID: <m4kd2h$urp$1@ger.gmane.org> On 2014-11-20 08:29, Thomas Koster wrote: > On Tue, Nov 18, 2014 at 4:59 PM, Thomas Koster <tkoster at gmail.com> wrote: >> -- | This version has a space leak. >> zerosAppA :: Application >> zerosAppA _req respond = >> withZeros 100000000 $ \ largeLBS -> >> respond $ responseStream status200 [] $ \ write _flush -> >> write $ fromLazyByteString largeLBS >> >> -- | This version does not have a space leak. >> zerosAppB :: Application >> zerosAppB _req respond = >> respond $ responseStream status200 [] $ \ write _flush -> >> withZeros 100000000 $ \ largeLBS -> >> write $ fromLazyByteString largeLBS > > On 20 November 2014 16:59, Bardur Arantsson <spam at scientician.net> wrote: >> I would recommend avoiding lazy I/O altogether and using >> "responseStream" instead. This will let you decide exactly what to write >> and when. > > I am already using responseStream. It's just that in my examples and > my real application, the 'octets' to be used for the response entity > ("largeLBS" from my examples) are provided to the callback as a lazy > bytestring built from lazy I/O, until I get my head around pipes and > conduit. > Lol, sorry, I guess I shouldn't be posting when I'm sick. :) I guess I got confused by the fact what you're using a huge LBS when you could just write it in pieces by providing the "write" and "flush" callbacks directly to the code which is actually generating the response (and let it be resposible for avoiding generating huge blobs). > built from lazy I/O, I would suggest *never* *ever* using lazy I/O. Even though it looks like the easy route, it's much harder to reason about than any of the alternatives. Btw, there are a couple of alternatives which you haven't mentioned (and thus may not be familiar with:) - Strict/direct I/O: Just use write/flush directly, do your own looping "until done" instead of hGetContents, etc. (I realize I've already mentioned it, I just repeat it here for completeness.) - io-streams: A very thin layer of stream abstractions directly on top of I/O. I found this much easier to get a handle on than either conduit or pipes, but then it's also less powerful and gives you very few abstractions independent of IO. Works very well in practice, though, if you just want to "get the job done". See https://hackage.haskell.org/package/io-streams Anyway, sorry about the dud reply before -- hopefully this'll be more helpful! Regards, From jon.fairbairn at cl.cam.ac.uk Thu Nov 20 15:58:07 2014 From: jon.fairbairn at cl.cam.ac.uk (Jon Fairbairn) Date: Thu, 20 Nov 2014 15:58:07 +0000 Subject: [Haskell-cafe] Generating valid html References: <5463E2D3.7040305@power.com.pl> <CACbaDy57YgCAtOUcG+B+E7qV-Frd4_bpoXYeid1AToDOH3_Z2A@mail.gmail.com> <54665FA2.3030902@power.com.pl> <wflhn825ck.fsf@calligramme.charmers> <546B6A7B.3000702@power.com.pl> Message-ID: <wfh9xt27ao.fsf@calligramme.charmers> Wojtek Narczy?ski <wojtek at power.com.pl> writes: > On 18.11.2014 11:03, Jon Fairbairn wrote: >> >> When you?ve done that, do have a look at mine (as posted >> earlier, there?s a snapshot at >> http:///scrap.bookofsand.co.uk/HTMLs.tar.gz ). It enforces more >> of the restrictions in the standards, but uses some more modern >> Haskell to do it. >> > > I have had a look, but frankly, the syntax of the html > generating codes is not as readable as in WASH. Using the WASH preprocessor, or the straight Haskell Monad syntax? The reason that I don?t have a Monad is that HTML with its nesting restrictions isn?t a Monad, and I couldn?t find Monads for Flow, Inline or Block either. Perhaps one could have separate Monads for Inline that has <a> in it and Inline that doesn?t and so on, but that would give too many Monads to be usable. -- J?n Fairbairn Jon.Fairbairn at cl.cam.ac.uk From R.Paterson at city.ac.uk Thu Nov 20 16:00:10 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Thu, 20 Nov 2014 16:00:10 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141120003749.GA7412@city.ac.uk> References: <CAMgWh9vksUPuxJMHRmuQzH1iaeAZc5mPvrXOwUJ40GrdUxVezA@mail.gmail.com> <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> Message-ID: <20141120160010.GA14319@city.ac.uk> On Thu, Nov 20, 2014 at 12:37:49AM +0000, Ross Paterson wrote: > On Wed, Nov 19, 2014 at 02:58:46PM -0500, David Feuer wrote: > > I got to looking at <*> just now, and it suggests the > > following question: is there a particularly efficient way to build a Seq when > > its ultimate size is known in advance, avoiding the usual incremental > > rebuilding? > > The following avoids the rebuilding, but I haven't tweaked or timed it: > > [...] Actually this is pretty much what the existing fromList2 does. From c at functionx.org Thu Nov 20 17:21:13 2014 From: c at functionx.org (Christopher Lewis) Date: Thu, 20 Nov 2014 12:21:13 -0500 Subject: [Haskell-cafe] NYC Haskell Developer Position Message-ID: <CAK_qUDO-nhWqHGT=VNihy1RNqwAduA6MuwRYZc58=+1JoQUEeQ@mail.gmail.com> Karamaan Group, a principal investment firm based in Manhattan, is looking for an outstanding software developer to develop tools for financial analysis and knowledge management. We are a growth oriented firm that values people who take a craftsman's pride in their work. Our ideal candidate is an experienced software developer with strong analytical, organizational, and communication skills. A candidate who demonstrates an intense focus on quality, but has the ability to recognize and make the tradeoffs that are a necessary part of day-to-day software development. Candidates should have at least a degree in a quantitative field and a keen interest in building robust and elegant computer programs. This is a high-impact, high-visibility position where successful candidates will be entrusted with a lot of responsibility for products that have a direct effect on the P&L of the firm and influences our workflow. The ideal candidate will have experience with Haskell, relational database technologies, and Java. All new development is performed in Haskell, but our legacy Java code base occasionally requires maintenance. Unlike most finance companies, our atmosphere is informal and intellectual. We don't require previous experience in finance or business, but knowledge in those areas is a plus. Karamaan Group is situated in Manhattan, we are an investment adviser to hedge funds and family offices. We value innovative thinking, encourage an entrepreneurial atmosphere, and enjoy spirited conversations. We also offer lunch, and every once in a while we go bowling. Please send your CV and cover letter to recruitment at karamaan dot com. From tifonzafel at gmail.com Thu Nov 20 17:44:40 2014 From: tifonzafel at gmail.com (felipe zapata) Date: Thu, 20 Nov 2014 12:44:40 -0500 Subject: [Haskell-cafe] suggestions about a library for numerical calculation Message-ID: <CA+AeLgQQOObFum95OcASKZaAXqQVdiBYf4wtqOhLeN4NNmaGPA@mail.gmail.com> Hi all, I want to develop some tools on top of Vector and Repa, and I've wondered what tools could be useful that are not already on hmatrix. Any suggestions would be appreciated, Felipe Z. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141120/daee0d3d/attachment.html> From wojtek at power.com.pl Thu Nov 20 17:48:03 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Thu, 20 Nov 2014 18:48:03 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <wfh9xt27ao.fsf@calligramme.charmers> References: <5463E2D3.7040305@power.com.pl> <CACbaDy57YgCAtOUcG+B+E7qV-Frd4_bpoXYeid1AToDOH3_Z2A@mail.gmail.com> <54665FA2.3030902@power.com.pl> <wflhn825ck.fsf@calligramme.charmers> <546B6A7B.3000702@power.com.pl> <wfh9xt27ao.fsf@calligramme.charmers> Message-ID: <546E2953.6060506@power.com.pl> On 20.11.2014 16:58, Jon Fairbairn wrote: > Using the WASH preprocessor, or the straight Haskell Monad syntax? I meant the plain haskell one, not the preprocessor (would probably be quotations these days). But I've had anotehr look, maybe it's just the way you use it with +++ between lines. > The reason that I don?t have a Monad is that HTML with > its nesting restrictions isn?t a Monad, and I couldn?t find > Monads for Flow, Inline or Block either. Perhaps one could have > separate Monads for Inline that has <a> in it and Inline that > doesn?t and so on, but that would give too many Monads to be > usable. > WASH is not monadic, and I don't think it can be made monadic, no way to restrict the initial FSM state (return), nor possible transitions (bind). By the way, can a type class be parametrized by a type class? -- Wojtek From tdammers at gmail.com Fri Nov 21 14:05:51 2014 From: tdammers at gmail.com (Tobias Dammers) Date: Fri, 21 Nov 2014 15:05:51 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <546CAD11.1030209@power.com.pl> References: <20141119084629.B5594C3841@www1.g3.pair.com> <546C7CBC.7070309@power.com.pl> <20141119121735.GB24596@nibbler> <546CAD11.1030209@power.com.pl> Message-ID: <CAK_X-ePKAjR+CSo-Lq+scFN54=XUSJAjgeuXuPgos1E3R6h4pA@mail.gmail.com> On Wed, Nov 19, 2014 at 03:45:37PM +0100, Wojtek Narczy?ski wrote: > On 19.11.2014 13:17, Tobias Dammers wrote: > >That's pretty much what my tamper library > >(http://hackage.haskell.org/package/tamper) is supposed to be. It's > >pretty rough around the edges still, and nowhere near as complete as > >Blaze itself, but it works well enough for basic HTML templating, and > >unlike Blaze, it is implemented as a monad transformer, which means you > >can integrate it with whatever monad stack you like. I couldn't find an > >existing solution to this myself, which is why I rolled my own. > Tobias, > > > I'm puzzled how your library can ensure that, for example <head> has only > one <title>, how / where are such rules enforced? Do you have a sample or > testcase? Ah, sorry for getting your hopes up. No, it doesn't ensure valid parent/child combinations or anything, it just does what basic Blaze-HTML does, but generalized to a monad transformer. > > > On the practical side, wouldn't you prefer to write, for example? > > {-#LANGUAGE Rank2Types #-} > > type ElementType = (Monad m, Ord t, IsString t) => TamperT t m () -> TamperT > t m () > > a, abbr, address, area, article, aside, audio :: ElementType > a = tag "a" > abbr = tag "abbr" > address = tag "address" > area = tagS "area" > article = tag "article" > aside = tag "aside" > audio = tag "audio" Good point; patches welcome in case I forget doing it myself ;) -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141121/19406986/attachment.html> From david.feuer at gmail.com Fri Nov 21 17:17:32 2014 From: david.feuer at gmail.com (David Feuer) Date: Fri, 21 Nov 2014 12:17:32 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141120160010.GA14319@city.ac.uk> References: <CAMgWh9vksUPuxJMHRmuQzH1iaeAZc5mPvrXOwUJ40GrdUxVezA@mail.gmail.com> <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> Message-ID: <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> On Thu, Nov 20, 2014 at 11:00 AM, Ross Paterson <R.Paterson at city.ac.uk> wrote: > On Thu, Nov 20, 2014 at 12:37:49AM +0000, Ross Paterson wrote: > > On Wed, Nov 19, 2014 at 02:58:46PM -0500, David Feuer wrote: > > > I got to looking at <*> just now, and it suggests the > > > following question: is there a particularly efficient way to build a > Seq when > > > its ultimate size is known in advance, avoiding the usual incremental > > > rebuilding? > > > > The following avoids the rebuilding, but I haven't tweaked or timed it: > > > > [...] > > Actually this is pretty much what the existing fromList2 does. > I think the technique fromList2 uses is probably sub-optimal for <*>, because it steps through things in order. The ends of fs <*> xs don't depend on the middle of f. It should be better, I think, to delay actually touching that middle until it's actually demanded. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141121/4fd37fdf/attachment.html> From david.feuer at gmail.com Fri Nov 21 19:00:16 2014 From: david.feuer at gmail.com (David Feuer) Date: Fri, 21 Nov 2014 14:00:16 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> References: <CAMgWh9vksUPuxJMHRmuQzH1iaeAZc5mPvrXOwUJ40GrdUxVezA@mail.gmail.com> <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> Message-ID: <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> To be precise, I *think* using the fromList approach for <*> makes us create O(n) thunks in order to extract the last element of the result. If we build the result inward, I *think* we can avoid this, getting the last element of the result in O(1) time and space. But my understanding of this data structure remains primitive. On Fri, Nov 21, 2014 at 12:17 PM, David Feuer <david.feuer at gmail.com> wrote: > On Thu, Nov 20, 2014 at 11:00 AM, Ross Paterson <R.Paterson at city.ac.uk> > wrote: > >> On Thu, Nov 20, 2014 at 12:37:49AM +0000, Ross Paterson wrote: >> > On Wed, Nov 19, 2014 at 02:58:46PM -0500, David Feuer wrote: >> > > I got to looking at <*> just now, and it suggests the >> > > following question: is there a particularly efficient way to build a >> Seq when >> > > its ultimate size is known in advance, avoiding the usual incremental >> > > rebuilding? >> > >> > The following avoids the rebuilding, but I haven't tweaked or timed it: >> > >> > [...] >> >> Actually this is pretty much what the existing fromList2 does. >> > > I think the technique fromList2 uses is probably sub-optimal for <*>, > because it steps through things in order. The ends of fs <*> xs don't > depend on the middle of f. It should be better, I think, to delay actually > touching that middle until it's actually demanded. > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141121/76a5e5a5/attachment.html> From R.Paterson at city.ac.uk Sat Nov 22 10:49:18 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Sat, 22 Nov 2014 10:49:18 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> References: <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> Message-ID: <20141122104918.GA2352@city.ac.uk> On Fri, Nov 21, 2014 at 02:00:16PM -0500, David Feuer wrote: > To be precise, I *think* using the fromList approach for <*> makes us create O > (n) thunks in order to extract the last element of the result. If we build the > result inward, I *think* we can avoid this, getting the last element of the > result in O(1) time and space. But my understanding of this data structure > remains primitive. This modification of the previous should do that. mult :: Seq (a -> b) -> Seq a -> Seq b mult sfs sxs = fromTwoLists (length sfs * length sxs) ys rev_ys where fs = toList sfs rev_fs = toRevList sfs xs = toList sxs rev_xs = toRevList sxs ys = [f x | f <- fs, x <- xs] rev_ys = [f x | f <- rev_fs, x <- rev_xs] -- toRevList xs = toList (reverse xs) toRevList :: Seq a -> [a] toRevList = foldl (flip (:)) [] -- Build a tree lazy in the middle, from a list and its reverse. -- -- fromTwoLists (length xs) xs (reverse xs) = fromList xs -- -- Getting the kth element from either end involves forcing the lists -- to length k. fromTwoLists :: Int -> [a] -> [a] -> Seq a fromTwoLists len_xs xs rev_xs = Seq $ mkTree2 len_xs 1 (map Elem xs) (map Elem rev_xs) -- Construct a fingertree from the first n elements of xs. -- The arguments must satisfy n <= length xs && rev_xs = reverse xs. -- Each element of xs has the same size, provided as an argument. mkTree2 :: Int -> Int -> [a] -> [a] -> FingerTree a mkTree2 n size xs rev_xs | n == 0 = Empty | n == 1 = let [x1] = xs in Single x1 | n < 6 = let nl = n `div` 2 l = Data.List.take nl xs r = Data.List.take (n - nl) rev_xs in Deep totalSize (mkDigit l) Empty (mkRevDigit r) | otherwise = let size' = 3*size n' = (n-4) `div` 3 digits = n - n'*3 nl = digits `div` 2 (l, xs') = Data.List.splitAt nl xs (r, rev_xs') = Data.List.splitAt (digits - nl) rev_xs nodes = mkNodes size' xs' rev_nodes = mkRevNodes size' rev_xs' in Deep totalSize (mkDigit l) (mkTree2 n' size' nodes rev_nodes) (mkRevDigit r) where totalSize = n*size mkDigit :: [a] -> Digit a mkDigit [x1] = One x1 mkDigit [x1, x2] = Two x1 x2 mkDigit [x1, x2, x3] = Three x1 x2 x3 mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4 -- length xs <= 4 => mkRevDigit xs = mkDigit (reverse xs) mkRevDigit :: [a] -> Digit a mkRevDigit [x1] = One x1 mkRevDigit [x2, x1] = Two x1 x2 mkRevDigit [x3, x2, x1] = Three x1 x2 x3 mkRevDigit [x4, x3, x2, x1] = Four x1 x2 x3 x4 mkNodes :: Int -> [a] -> [Node a] mkNodes size (x1:x2:x3:xs) = Node3 size x1 x2 x3:mkNodes size xs -- length xs `mod` 3 == 0 => -- mkRevNodes size xs = reverse (mkNodes size (reverse xs)) mkRevNodes :: Int -> [a] -> [Node a] mkRevNodes size (x3:x2:x1:xs) = Node3 size x1 x2 x3:mkRevNodes size xs From R.Paterson at city.ac.uk Sat Nov 22 13:16:17 2014 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Sat, 22 Nov 2014 13:16:17 +0000 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141122104918.GA2352@city.ac.uk> References: <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> <20141122104918.GA2352@city.ac.uk> Message-ID: <20141122131617.GA2934@city.ac.uk> On Sat, Nov 22, 2014 at 10:49:18AM +0000, Ross Paterson wrote: > -- Construct a fingertree from the first n elements of xs. > -- The arguments must satisfy n <= length xs && rev_xs = reverse xs. > -- Each element of xs has the same size, provided as an argument. Sorry, that should read: -- The arguments must satisfy n <= length xs && take n rev_xs = reverse (take n xs). From agocorona at gmail.com Sat Nov 22 16:56:39 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Sat, 22 Nov 2014 17:56:39 +0100 Subject: [Haskell-cafe] Monads: external questions In-Reply-To: <42C27B93-3F2C-4EA9-8847-FE5A6B54638E@proclivis.com> References: <CAEc4Ma02GOD_ZQwBtdiZO_XAdsMusFy=avZCViA_3SLWW6_qDA@mail.gmail.com> <CAArEJmZ8W1HDFuuG2wC8MsQHuW-DBC0QQYYiCcZr6D=EfogjEQ@mail.gmail.com> <CAArEJmZNup_px2UAJAPk=4oidJ=U42tfcd0obePMJ2r7L6yU8g@mail.gmail.com> <42C27B93-3F2C-4EA9-8847-FE5A6B54638E@proclivis.com> Message-ID: <CAArEJmaOqKsWtfQRPUh46MrvK+t+pFr_zb_fk8FFakdo8rN3Ew@mail.gmail.com> Michael: You are right, but these are minor problems I think, compared with the huge potential advantages. I can not believe it when a slow immature language like Ruby could take over web development just for one library, Rails and some buzzwords, when a faster, safer language can do it millions of times better. Haskell can revolutionize all the industry simply selling it not as one more language, but as THE meta-language for building EDSLs for each domain problem. some EDSLs so close to the domain problem that can be used by non-programmers. That lack of vision and effort in the side of the haskell community hurts me. And the lack of interest in this ticket https://ghc.haskell.org/trac/ghc/ticket/7870 Is a clear display of this lack of interest. it is like the Aristocracy of the Haskell Wondwerland fears to be hijacked by hordes of mediocre DSL villains from the industry, so it is necessary to keep the walls high Haskell is a language dominated by academics that has no interest in the success of Haskell. On the contrary. 2014-10-29 15:13 GMT+01:00 Michael Jones <mike at proclivis.com>: > When I took a Lambda Calculus class years ago in Silicon Valley, 90% of > the students groaned and complained. They just wanted to learn Java and > make money. Having a background in OO design and experience with Eiffel, I > was intrigued and stuck with it, building some tools with ML, and later > Haskell. > > In the workplace it was near impossible to avoid the .Net culture, and > most of my code has been C#. But the factors that mattered were: > > - Continuity with past languages and tools > - Availability of programmers > - Third party libraries > - Inter langage operability > - Reuse of legacy code > > etc > > Best I can tell, there is no way to avoid the business context. I suggest > that if you have freedom, you need to be multilingual. Many systems could > benefit from applying the proper tool to the corresponding problem. > > But I will say this, becoming proficient at Haskell really improved my > designs by providing an alternative conceptual framework. But, it had a > very substantial learning curve. All I can say is trust that even if your > core language is procedural, you will be better at that for learning a > functional language. > > To make Haskell a first class citizen in the IT shops, I think focus would > have to shift more to the business context and needs. And certainly more > focus in the universities that are still dominated by procedural languages. > Once that is drilled into ones head, it affects the way one thinks. > > To give an example, I have these problems: > > - Update to GHC 7.8.3 from 7.6 caused run time behavior changes breaking > USB application > - Sandboxes are not completely isolated from the core library and often > builds break > - Most new grads don?t even know what a functional language is > - Documentation gets out of sync with releases (where documentation means > Wiki and web) > - FFI is difficult to use and debug > - Lack of books, user groups, etc > > Mike > > On Oct 29, 2014, at 3:48 AM, Alberto G. Corona <agocorona at gmail.com> > wrote: > > I know that I'm using a different language when talking about monads. The > language of the IT industry. > > Many haskellers use the language for toy programming. Others are > professional academics. The few that use the language for commercial > purposes are too busy developing practical applications rather than > thinking deep about how to apply the haskell concepts to their problems. > As a result many of such problems remains essentially unsolved. These busy > developers try to transcode solutions from other languages that lack the > deep and expressiveness of Haskell. > > This lack of interest in one side and the lack of time in the other is > disappointing. The symptoms are everywhere. Particularly, I find it in the > lack of support and interests for this ticket: > > https://ghc.haskell.org/trac/ghc/ticket/7870 > > I though that there was definitively a shift from "avoid success at all > costs" a few years ago, for a commitment for the success, but still there > are many minds to change, especially the brilliant ones. > > 2014-10-26 2:02 GMT+01:00 Alberto G. Corona <agocorona at gmail.com>: > >> >> >> 2014-10-26 1:23 GMT+02:00 Jeffrey Brown <jeffbrown.the at gmail.com>: >> >>> As opposed to the internal logic of monads, how they work, I hope to >>> start a discussion about their external logic: how and why to use monads. >>> >>> design >>> ------ >>> How do monads change the way one >>> * thinks about a problem? >>> * structures data? >>> * refactors? >>> * tests? >>> Should I always be giving the monads a lot of cognitive bandwidth, >>> because they reorder the way everything should be, or is it an investment >>> with a high initial cognitive cost but requiring little maintenance >>> thereafter? >>> >>> what is their common framework? >>> ------------------------------- >>> Monads let data reach farther than it otherwise would. Subjectively, >>> they feel like a controlled way of violating encapsulation. >>> >>> Are there other, deeper or more specific, commonalities that explain why >>> monads are a good way to implement exceptions, output, state, and perhaps >>> other services? >>> >> >> I made monads for execution state recovery, web navigation.. workflows, >> long running transactions, backtracking, traceback and event chaining in >> web browser applications. >> >> I?m confident that the perspectives for monads to solve real IT problems >> are very promising. And when I mean monad I mean all the associated stuff : >> applicative, alternative etc. >> >> I?m confident that there will be a cloud monad (for chaining jobs and >> work distribution) an orchestration monad for orchestration of web services >> etc. >> >> There are problems that are intrinsically procedural among them, almost >> all problems in IT. instead of using ad-hoc data/control structures like >> events, handlers, configurations, routes, exceptions, logs, transaction >> compensations, promises ....the list goes on and on , the monad is the >> common control structure that can subsume all of them inside his >> programmable semicolon >> >> So, once the monad is set up, the user of the monad code the solution for >> the domain problem in a clean EDSL with absolutely no plumbing, at the >> level of the problem. so anyone that know the problem can understand the >> code. >> >> Is the monad instance, and the applicative etc the ones that subsume >> under the hood the special data/control structure necessary for the domain >> problem. >> >> >> Often if your code is general enough, it can be used in any monad. So you >> benefit from this. I think that in th future there will be a lot of >> surprises about the shareability of code between monads when the IT >> industry start to use them seriously. I think that we are just at the >> beginning. >> >> I hope that some others of your questions are also answered here >> > > > > -- > Alberto. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141122/c361d668/attachment.html> From spam at scientician.net Sat Nov 22 17:17:42 2014 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 22 Nov 2014 18:17:42 +0100 Subject: [Haskell-cafe] Monads: external questions In-Reply-To: <CAArEJmaOqKsWtfQRPUh46MrvK+t+pFr_zb_fk8FFakdo8rN3Ew@mail.gmail.com> References: <CAEc4Ma02GOD_ZQwBtdiZO_XAdsMusFy=avZCViA_3SLWW6_qDA@mail.gmail.com> <CAArEJmZ8W1HDFuuG2wC8MsQHuW-DBC0QQYYiCcZr6D=EfogjEQ@mail.gmail.com> <CAArEJmZNup_px2UAJAPk=4oidJ=U42tfcd0obePMJ2r7L6yU8g@mail.gmail.com> <42C27B93-3F2C-4EA9-8847-FE5A6B54638E@proclivis.com> <CAArEJmaOqKsWtfQRPUh46MrvK+t+pFr_zb_fk8FFakdo8rN3Ew@mail.gmail.com> Message-ID: <m4qgfm$qij$1@ger.gmane.org> On 2014-11-22 17:56, Alberto G. Corona wrote: > Michael: > > You are right, but these are minor problems I think, compared with the huge > potential advantages. > > I can not believe it when a slow immature language like Ruby could take > over web development just for one library, Rails and some buzzwords, when a > faster, safer language can do it millions of times better. Haskell can > revolutionize all the industry simply selling it not as one more language, > but as THE meta-language for building EDSLs for each domain problem. some > EDSLs so close to the domain problem that can be used by non-programmers. > > That lack of vision and effort in the side of the haskell community hurts > me. And the lack of interest in this ticket > > https://ghc.haskell.org/trac/ghc/ticket/7870 > > Is a clear display of this lack of interest. it is like the Aristocracy of > the Haskell Wondwerland fears to be hijacked by hordes of mediocre DSL > villains from the industry, so it is necessary to keep the walls high Not that I necessarily agree or disagree with what you're saying, but that is a completely useless ticket. It's *way* too open-ended and doesn't seem to have very many specifics about what's the desired feature actually *is*. I submit that you're likely to get a lot more traction if you actually worked to specify *exactly* what's the desired feature is, i.e. *specify* the stripped down algorithm that you want implemented, how it's going to be integrated with user code, how it can be used to improve error reporting for EDSLs, etc. (I believe it's customary to create a Trac Wiki page for any proposed features.) > > Haskell is a language dominated by academics that has no interest in the > success of Haskell. On the contrary. > Well, the unofficial Haskell motto *is* "Avoid success at all costs", so y'know... :) Regards, From david.feuer at gmail.com Sat Nov 22 17:57:18 2014 From: david.feuer at gmail.com (David Feuer) Date: Sat, 22 Nov 2014 12:57:18 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <20141122104918.GA2352@city.ac.uk> References: <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> <20141122104918.GA2352@city.ac.uk> Message-ID: <CAMgWh9uyPKQaFHNYLqg2V5OXUXuuDy3N3g34GdKNePdA6HeU-A@mail.gmail.com> The ideal goal, which has taken me forever to identify and which may well be unattainable, is to get O(log(min{i,mn-i})) access to each element of the result, while maintaining O(mn) time to force it entirely. Each of these is possible separately, of course. To get them both, if it's possible, we need to give up on the list-like approach and start splitting Seqs instead of lists. As we descend, we want to pass a single thunk to each element of each Digit to give it just enough to do its thing. Representing the splits efficiently and/or memoizing them could be a bit of a challenge. On Fri, Nov 21, 2014 at 02:00:16PM -0500, David Feuer wrote: > To be precise, I *think* using the fromList approach for <*> makes us create O > (n) thunks in order to extract the last element of the result. If we build the > result inward, I *think* we can avoid this, getting the last element of the > result in O(1) time and space. But my understanding of this data structure > remains primitive. This modification of the previous should do that. mult :: Seq (a -> b) -> Seq a -> Seq b mult sfs sxs = fromTwoLists (length sfs * length sxs) ys rev_ys where fs = toList sfs rev_fs = toRevList sfs xs = toList sxs rev_xs = toRevList sxs ys = [f x | f <- fs, x <- xs] rev_ys = [f x | f <- rev_fs, x <- rev_xs] -- toRevList xs = toList (reverse xs) toRevList :: Seq a -> [a] toRevList = foldl (flip (:)) [] -- Build a tree lazy in the middle, from a list and its reverse. -- -- fromTwoLists (length xs) xs (reverse xs) = fromList xs -- -- Getting the kth element from either end involves forcing the lists -- to length k. fromTwoLists :: Int -> [a] -> [a] -> Seq a fromTwoLists len_xs xs rev_xs = Seq $ mkTree2 len_xs 1 (map Elem xs) (map Elem rev_xs) -- Construct a fingertree from the first n elements of xs. -- The arguments must satisfy n <= length xs && rev_xs = reverse xs. -- Each element of xs has the same size, provided as an argument. mkTree2 :: Int -> Int -> [a] -> [a] -> FingerTree a mkTree2 n size xs rev_xs | n == 0 = Empty | n == 1 = let [x1] = xs in Single x1 | n < 6 = let nl = n `div` 2 l = Data.List.take nl xs r = Data.List.take (n - nl) rev_xs in Deep totalSize (mkDigit l) Empty (mkRevDigit r) | otherwise = let size' = 3*size n' = (n-4) `div` 3 digits = n - n'*3 nl = digits `div` 2 (l, xs') = Data.List.splitAt nl xs (r, rev_xs') = Data.List.splitAt (digits - nl) rev_xs nodes = mkNodes size' xs' rev_nodes = mkRevNodes size' rev_xs' in Deep totalSize (mkDigit l) (mkTree2 n' size' nodes rev_nodes) (mkRevDigit r) where totalSize = n*size mkDigit :: [a] -> Digit a mkDigit [x1] = One x1 mkDigit [x1, x2] = Two x1 x2 mkDigit [x1, x2, x3] = Three x1 x2 x3 mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4 -- length xs <= 4 => mkRevDigit xs = mkDigit (reverse xs) mkRevDigit :: [a] -> Digit a mkRevDigit [x1] = One x1 mkRevDigit [x2, x1] = Two x1 x2 mkRevDigit [x3, x2, x1] = Three x1 x2 x3 mkRevDigit [x4, x3, x2, x1] = Four x1 x2 x3 x4 mkNodes :: Int -> [a] -> [Node a] mkNodes size (x1:x2:x3:xs) = Node3 size x1 x2 x3:mkNodes size xs -- length xs `mod` 3 == 0 => -- mkRevNodes size xs = reverse (mkNodes size (reverse xs)) mkRevNodes :: Int -> [a] -> [Node a] mkRevNodes size (x3:x2:x1:xs) = Node3 size x1 x2 x3:mkRevNodes size xs _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe at haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141122/03f82ef7/attachment.html> From erantapaa at gmail.com Sat Nov 22 21:13:06 2014 From: erantapaa at gmail.com (Erik Rantapaa) Date: Sat, 22 Nov 2014 15:13:06 -0600 Subject: [Haskell-cafe] GC times with +RTS -N2 -s Message-ID: <CA+NR3OvrS6cU97qHpRFHEE4ESbBUFXX1iBMrqCibDYu2gP64xw@mail.gmail.com> When I run the sudoko2 program from the parconc-examples package, I get output like: ... SPARKS: 2 (1 converted, 0 overflowed, 0 dud, 0 GC'd, 1 fizzled) INIT time 0.00s ( 0.02s elapsed) MUT time 1.75s ( 1.44s elapsed) GC time 0.73s ( 0.14s elapsed) EXIT time 0.00s ( 0.00s elapsed) Total time 2.48s ( 1.60s elapsed) ... My full command line is: ./sudoku2 sudoku17.1000.txt +RTS -N2 -s I understand how to interpret the Total time - 2.48 seconds is the total time spent by both cores and 1.6 seconds is the running time of the program as a whole. But how should interpret the GC times? What do 0.73s and 0.14s actually represent? This is with GHC 7.8.3, OSX 10.8.5, 64-bit Haskell Platform. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141122/94050e86/attachment.html> From sean.seefried at gmail.com Sat Nov 22 23:01:50 2014 From: sean.seefried at gmail.com (Sean Seefried) Date: Sat, 22 Nov 2014 23:01:50 +0000 Subject: [Haskell-cafe] Domain specific error messages Message-ID: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> If the list doesn't mind I'm reposting my reply to Alberto G. Corona in under the thread "Monads: external questions" as a new message since the topic has changed enough. ------------- Hi Alberto, I've been interested in domain specific error messages for years and I agree with you that it is one of the major things holding back the utility of DSLs to novice programmers. This is a shame since one of the touted benefits of DSLs is that they *can* be used by novices with a minimum of training, which is simply not true in the presence of error messages that require detailed knowledge of Haskell to understand. I'd caution against saying that there is a lack of interest in that ticket you linked to. It's still a research level problem despite the fact that some great work has been done on it already. Incidentally, the author of "Scripting the Type Inference Process" went on to do an entire PhD on the topic entitled "Top Quality Type Error Messages"[2]. I recently wrote him an email and he told me that the constraint-based type inference framework that he used in the thesis, TOP, is available on Hackage [3]. Recently I noticed that this problem is already being worked on in Idris. See "Reflect on your Mistakes!" [4] and some code on GitHub [5]. Perhaps we can get people interested in this feature again? Cheers, Sean [1] http://www.open.ou.nl/bhr/heeren-scripting.pdf [2] http://www.open.ou.nl/bhr/TopQuality.pdf [3] https://hackage.haskell.org/package/Top [4] http://www.itu.dk/people/drc/drafts/error-reflection-submission.pdf [5] https://gist.github.com/david-christiansen/8349698 On Sun Nov 23 2014 at 3:57:10 AM Alberto G. Corona <agocorona at gmail.com> wrote: > Michael: > > You are right, but these are minor problems I think, compared with the > huge potential advantages. > > I can not believe it when a slow immature language like Ruby could take > over web development just for one library, Rails and some buzzwords, when a > faster, safer language can do it millions of times better. Haskell can > revolutionize all the industry simply selling it not as one more language, > but as THE meta-language for building EDSLs for each domain problem. some > EDSLs so close to the domain problem that can be used by non-programmers. > > That lack of vision and effort in the side of the haskell community hurts > me. And the lack of interest in this ticket > > https://ghc.haskell.org/trac/ghc/ticket/7870 > > Is a clear display of this lack of interest. it is like the Aristocracy > of the Haskell Wondwerland fears to be hijacked by hordes of mediocre DSL > villains from the industry, so it is necessary to keep the walls high > > Haskell is a language dominated by academics that has no interest in the > success of Haskell. On the contrary. > > 2014-10-29 15:13 GMT+01:00 Michael Jones <mike at proclivis.com>: > >> When I took a Lambda Calculus class years ago in Silicon Valley, 90% of >> the students groaned and complained. They just wanted to learn Java and >> make money. Having a background in OO design and experience with Eiffel, I >> was intrigued and stuck with it, building some tools with ML, and later >> Haskell. >> >> In the workplace it was near impossible to avoid the .Net culture, and >> most of my code has been C#. But the factors that mattered were: >> >> - Continuity with past languages and tools >> - Availability of programmers >> - Third party libraries >> - Inter langage operability >> - Reuse of legacy code >> >> etc >> >> Best I can tell, there is no way to avoid the business context. I suggest >> that if you have freedom, you need to be multilingual. Many systems could >> benefit from applying the proper tool to the corresponding problem. >> >> But I will say this, becoming proficient at Haskell really improved my >> designs by providing an alternative conceptual framework. But, it had a >> very substantial learning curve. All I can say is trust that even if your >> core language is procedural, you will be better at that for learning a >> functional language. >> >> To make Haskell a first class citizen in the IT shops, I think focus >> would have to shift more to the business context and needs. And certainly >> more focus in the universities that are still dominated by procedural >> languages. Once that is drilled into ones head, it affects the way one >> thinks. >> >> To give an example, I have these problems: >> >> - Update to GHC 7.8.3 from 7.6 caused run time behavior changes breaking >> USB application >> - Sandboxes are not completely isolated from the core library and often >> builds break >> - Most new grads don?t even know what a functional language is >> - Documentation gets out of sync with releases (where documentation means >> Wiki and web) >> - FFI is difficult to use and debug >> - Lack of books, user groups, etc >> >> Mike >> >> On Oct 29, 2014, at 3:48 AM, Alberto G. Corona <agocorona at gmail.com> >> wrote: >> >> I know that I'm using a different language when talking about monads. The >> language of the IT industry. >> >> Many haskellers use the language for toy programming. Others are >> professional academics. The few that use the language for commercial >> purposes are too busy developing practical applications rather than >> thinking deep about how to apply the haskell concepts to their problems. >> As a result many of such problems remains essentially unsolved. These busy >> developers try to transcode solutions from other languages that lack the >> deep and expressiveness of Haskell. >> >> This lack of interest in one side and the lack of time in the other is >> disappointing. The symptoms are everywhere. Particularly, I find it in the >> lack of support and interests for this ticket: >> >> https://ghc.haskell.org/trac/ghc/ticket/7870 >> >> I though that there was definitively a shift from "avoid success at all >> costs" a few years ago, for a commitment for the success, but still there >> are many minds to change, especially the brilliant ones. >> >> 2014-10-26 2:02 GMT+01:00 Alberto G. Corona <agocorona at gmail.com>: >> >>> >>> >>> 2014-10-26 1:23 GMT+02:00 Jeffrey Brown <jeffbrown.the at gmail.com>: >>> >>>> As opposed to the internal logic of monads, how they work, I hope to >>>> start a discussion about their external logic: how and why to use monads. >>>> >>>> design >>>> ------ >>>> How do monads change the way one >>>> * thinks about a problem? >>>> * structures data? >>>> * refactors? >>>> * tests? >>>> Should I always be giving the monads a lot of cognitive bandwidth, >>>> because they reorder the way everything should be, or is it an investment >>>> with a high initial cognitive cost but requiring little maintenance >>>> thereafter? >>>> >>>> what is their common framework? >>>> ------------------------------- >>>> Monads let data reach farther than it otherwise would. Subjectively, >>>> they feel like a controlled way of violating encapsulation. >>>> >>>> Are there other, deeper or more specific, commonalities that explain >>>> why monads are a good way to implement exceptions, output, state, and >>>> perhaps other services? >>>> >>> >>> I made monads for execution state recovery, web navigation.. workflows, >>> long running transactions, backtracking, traceback and event chaining in >>> web browser applications. >>> >>> I?m confident that the perspectives for monads to solve real IT problems >>> are very promising. And when I mean monad I mean all the associated stuff : >>> applicative, alternative etc. >>> >>> I?m confident that there will be a cloud monad (for chaining jobs and >>> work distribution) an orchestration monad for orchestration of web services >>> etc. >>> >>> There are problems that are intrinsically procedural among them, almost >>> all problems in IT. instead of using ad-hoc data/control structures like >>> events, handlers, configurations, routes, exceptions, logs, transaction >>> compensations, promises ....the list goes on and on , the monad is the >>> common control structure that can subsume all of them inside his >>> programmable semicolon >>> >>> So, once the monad is set up, the user of the monad code the solution >>> for the domain problem in a clean EDSL with absolutely no plumbing, at the >>> level of the problem. so anyone that know the problem can understand the >>> code. >>> >>> Is the monad instance, and the applicative etc the ones that subsume >>> under the hood the special data/control structure necessary for the domain >>> problem. >>> >>> >>> Often if your code is general enough, it can be used in any monad. So >>> you benefit from this. I think that in th future there will be a lot of >>> surprises about the shareability of code between monads when the IT >>> industry start to use them seriously. I think that we are just at the >>> beginning. >>> >>> I hope that some others of your questions are also answered here >>> >> >> >> >> -- >> Alberto. >> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141122/6f982a6d/attachment.html> From david.feuer at gmail.com Sun Nov 23 03:10:46 2014 From: david.feuer at gmail.com (David Feuer) Date: Sat, 22 Nov 2014 22:10:46 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <CAMgWh9uyPKQaFHNYLqg2V5OXUXuuDy3N3g34GdKNePdA6HeU-A@mail.gmail.com> References: <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> <20141122104918.GA2352@city.ac.uk> <CAMgWh9uyPKQaFHNYLqg2V5OXUXuuDy3N3g34GdKNePdA6HeU-A@mail.gmail.com> Message-ID: <CAMgWh9srB0_mJn9o5vMR9RFqiZ2=56NaAzikKuaG9orDsfjsEQ@mail.gmail.com> OK, so I've thought about this some more. I think the essential *concept* I want is close to this, but it won't quite work this way: fs <*> xs = equalJoin $ fmap (<$> xs) fs equalJoin :: Int -> Seq (Seq a) -> Seq a equalJoin n s | length s <= 2*n = simpleJoin s | otherwise = simpleJoin pref >< equalJoin (2*n) mid >< simpleJoin suff where (pref, s') = splitAt n s (mid, suff) = splitAt (length s - 2*n) s' simpleJoin :: Seq (Seq a) -> Seq a simpleJoin s | null s = empty | length s == 1 = index s 0 | otherwise = simpleJoin front >< simpleJoin back where (front,back) = splitAt (length s `quot` 2) s I think the reason this doesn't work is that >< is too strict. I believe the only potential way around this is to dig into the FingerTree representation and build the thing top-down. I still don't understand how (if at all) this can be done. On Sat, Nov 22, 2014 at 12:57 PM, David Feuer <david.feuer at gmail.com> wrote: > The ideal goal, which has taken me forever to identify and which may well > be unattainable, is to get O(log(min{i,mn-i})) access to each element of > the result, while maintaining O(mn) time to force it entirely. Each of > these is possible separately, of course. To get them both, if it's > possible, we need to give up on the list-like approach and start splitting > Seqs instead of lists. As we descend, we want to pass a single thunk to > each element of each Digit to give it just enough to do its thing. > Representing the splits efficiently and/or memoizing them could be a bit of > a challenge. > On Fri, Nov 21, 2014 at 02:00:16PM -0500, David Feuer wrote: > > To be precise, I *think* using the fromList approach for <*> makes us > create O > > (n) thunks in order to extract the last element of the result. If we > build the > > result inward, I *think* we can avoid this, getting the last element of > the > > result in O(1) time and space. But my understanding of this data > structure > > remains primitive. > > This modification of the previous should do that. > > mult :: Seq (a -> b) -> Seq a -> Seq b > mult sfs sxs = fromTwoLists (length sfs * length sxs) ys rev_ys > where > fs = toList sfs > rev_fs = toRevList sfs > xs = toList sxs > rev_xs = toRevList sxs > ys = [f x | f <- fs, x <- xs] > rev_ys = [f x | f <- rev_fs, x <- rev_xs] > > -- toRevList xs = toList (reverse xs) > toRevList :: Seq a -> [a] > toRevList = foldl (flip (:)) [] > > -- Build a tree lazy in the middle, from a list and its reverse. > -- > -- fromTwoLists (length xs) xs (reverse xs) = fromList xs > -- > -- Getting the kth element from either end involves forcing the lists > -- to length k. > fromTwoLists :: Int -> [a] -> [a] -> Seq a > fromTwoLists len_xs xs rev_xs = > Seq $ mkTree2 len_xs 1 (map Elem xs) (map Elem rev_xs) > > -- Construct a fingertree from the first n elements of xs. > -- The arguments must satisfy n <= length xs && rev_xs = reverse xs. > -- Each element of xs has the same size, provided as an argument. > mkTree2 :: Int -> Int -> [a] -> [a] -> FingerTree a > mkTree2 n size xs rev_xs > | n == 0 = Empty > | n == 1 = let [x1] = xs in Single x1 > | n < 6 = let > nl = n `div` 2 > l = Data.List.take nl xs > r = Data.List.take (n - nl) rev_xs > in Deep totalSize (mkDigit l) Empty (mkRevDigit r) > | otherwise = let > size' = 3*size > n' = (n-4) `div` 3 > digits = n - n'*3 > nl = digits `div` 2 > (l, xs') = Data.List.splitAt nl xs > (r, rev_xs') = Data.List.splitAt (digits - nl) rev_xs > nodes = mkNodes size' xs' > rev_nodes = mkRevNodes size' rev_xs' > in Deep totalSize (mkDigit l) (mkTree2 n' size' nodes rev_nodes) > (mkRevDigit r) > where > totalSize = n*size > > mkDigit :: [a] -> Digit a > mkDigit [x1] = One x1 > mkDigit [x1, x2] = Two x1 x2 > mkDigit [x1, x2, x3] = Three x1 x2 x3 > mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4 > > -- length xs <= 4 => mkRevDigit xs = mkDigit (reverse xs) > mkRevDigit :: [a] -> Digit a > mkRevDigit [x1] = One x1 > mkRevDigit [x2, x1] = Two x1 x2 > mkRevDigit [x3, x2, x1] = Three x1 x2 x3 > mkRevDigit [x4, x3, x2, x1] = Four x1 x2 x3 x4 > > mkNodes :: Int -> [a] -> [Node a] > mkNodes size (x1:x2:x3:xs) = Node3 size x1 x2 x3:mkNodes size xs > > -- length xs `mod` 3 == 0 => > -- mkRevNodes size xs = reverse (mkNodes size (reverse xs)) > mkRevNodes :: Int -> [a] -> [Node a] > mkRevNodes size (x3:x2:x1:xs) = Node3 size x1 x2 x3:mkRevNodes size xs > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141122/d550a599/attachment.html> From david.feuer at gmail.com Sun Nov 23 05:07:56 2014 From: david.feuer at gmail.com (David Feuer) Date: Sun, 23 Nov 2014 00:07:56 -0500 Subject: [Haskell-cafe] Improving *> and >> for Data.Sequence In-Reply-To: <CAMgWh9srB0_mJn9o5vMR9RFqiZ2=56NaAzikKuaG9orDsfjsEQ@mail.gmail.com> References: <20141119164556.GA5245@city.ac.uk> <CAMgWh9ui76-YjQ=hE8KiHzeb34XpWdWQRSW7ELr1yRZ5eg-A7Q@mail.gmail.com> <20141119185004.GA5915@city.ac.uk> <CAMgWh9twVjZdXgOedt74=Jre7bEBH_kR9esne1A9-SpkRx9Wmw@mail.gmail.com> <20141119190208.GA6047@city.ac.uk> <CAMgWh9vLSOf4F9dgTPAWsJ=kjYC6Y8GdGFWGL-yG8B5vKFJ72Q@mail.gmail.com> <20141120003749.GA7412@city.ac.uk> <20141120160010.GA14319@city.ac.uk> <CAMgWh9tr4zYOYo63rhXqc951kn49Cwe3_gA3A+7yHWE8bNyefw@mail.gmail.com> <CAMgWh9vJ6cGkGr4zW72LWp3SmS6-uX4odQ2_Wct8bkbZE1pR5Q@mail.gmail.com> <20141122104918.GA2352@city.ac.uk> <CAMgWh9uyPKQaFHNYLqg2V5OXUXuuDy3N3g34GdKNePdA6HeU-A@mail.gmail.com> <CAMgWh9srB0_mJn9o5vMR9RFqiZ2=56NaAzikKuaG9orDsfjsEQ@mail.gmail.com> Message-ID: <CAMgWh9vvcohf6wFsHVPoXjseLLxyFKDzxzQpO8zbnC9vp=DdEA@mail.gmail.com> OK, sorry for the flood of posts, but I think I've found a way to make that work. Specifically, I think I can write a three-Seq append that takes the total size and uses it to be as lazy as possible in the second of the three Seqs. I'm still working out the details, but I think it will work. It does the (possibly avoidable) rebuilding, but I *think* it's at least asymptotically optimal. Of course, if Ross Paterson can find something more efficient, that'd be even better. On Sat, Nov 22, 2014 at 10:10 PM, David Feuer <david.feuer at gmail.com> wrote: > OK, so I've thought about this some more. I think the essential *concept* > I want is close to this, but it won't quite work this way: > > fs <*> xs = equalJoin $ fmap (<$> xs) fs > > equalJoin :: Int -> Seq (Seq a) -> Seq a > equalJoin n s > | length s <= 2*n = simpleJoin s > | otherwise = simpleJoin pref >< > equalJoin (2*n) mid >< > simpleJoin suff > where (pref, s') = splitAt n s > (mid, suff) = splitAt (length s - 2*n) s' > > simpleJoin :: Seq (Seq a) -> Seq a > simpleJoin s > | null s = empty > | length s == 1 = index s 0 > | otherwise = simpleJoin front >< simpleJoin back > where > (front,back) = splitAt (length s `quot` 2) s > > I think the reason this doesn't work is that >< is too strict. I believe > the only potential way around this is to dig into the FingerTree > representation and build the thing top-down. I still don't understand how > (if at all) this can be done. > > > On Sat, Nov 22, 2014 at 12:57 PM, David Feuer <david.feuer at gmail.com> > wrote: > >> The ideal goal, which has taken me forever to identify and which may well >> be unattainable, is to get O(log(min{i,mn-i})) access to each element of >> the result, while maintaining O(mn) time to force it entirely. Each of >> these is possible separately, of course. To get them both, if it's >> possible, we need to give up on the list-like approach and start splitting >> Seqs instead of lists. As we descend, we want to pass a single thunk to >> each element of each Digit to give it just enough to do its thing. >> Representing the splits efficiently and/or memoizing them could be a bit of >> a challenge. >> On Fri, Nov 21, 2014 at 02:00:16PM -0500, David Feuer wrote: >> > To be precise, I *think* using the fromList approach for <*> makes us >> create O >> > (n) thunks in order to extract the last element of the result. If we >> build the >> > result inward, I *think* we can avoid this, getting the last element of >> the >> > result in O(1) time and space. But my understanding of this data >> structure >> > remains primitive. >> >> This modification of the previous should do that. >> >> mult :: Seq (a -> b) -> Seq a -> Seq b >> mult sfs sxs = fromTwoLists (length sfs * length sxs) ys rev_ys >> where >> fs = toList sfs >> rev_fs = toRevList sfs >> xs = toList sxs >> rev_xs = toRevList sxs >> ys = [f x | f <- fs, x <- xs] >> rev_ys = [f x | f <- rev_fs, x <- rev_xs] >> >> -- toRevList xs = toList (reverse xs) >> toRevList :: Seq a -> [a] >> toRevList = foldl (flip (:)) [] >> >> -- Build a tree lazy in the middle, from a list and its reverse. >> -- >> -- fromTwoLists (length xs) xs (reverse xs) = fromList xs >> -- >> -- Getting the kth element from either end involves forcing the lists >> -- to length k. >> fromTwoLists :: Int -> [a] -> [a] -> Seq a >> fromTwoLists len_xs xs rev_xs = >> Seq $ mkTree2 len_xs 1 (map Elem xs) (map Elem rev_xs) >> >> -- Construct a fingertree from the first n elements of xs. >> -- The arguments must satisfy n <= length xs && rev_xs = reverse xs. >> -- Each element of xs has the same size, provided as an argument. >> mkTree2 :: Int -> Int -> [a] -> [a] -> FingerTree a >> mkTree2 n size xs rev_xs >> | n == 0 = Empty >> | n == 1 = let [x1] = xs in Single x1 >> | n < 6 = let >> nl = n `div` 2 >> l = Data.List.take nl xs >> r = Data.List.take (n - nl) rev_xs >> in Deep totalSize (mkDigit l) Empty (mkRevDigit r) >> | otherwise = let >> size' = 3*size >> n' = (n-4) `div` 3 >> digits = n - n'*3 >> nl = digits `div` 2 >> (l, xs') = Data.List.splitAt nl xs >> (r, rev_xs') = Data.List.splitAt (digits - nl) rev_xs >> nodes = mkNodes size' xs' >> rev_nodes = mkRevNodes size' rev_xs' >> in Deep totalSize (mkDigit l) (mkTree2 n' size' nodes rev_nodes) >> (mkRevDigit r) >> where >> totalSize = n*size >> >> mkDigit :: [a] -> Digit a >> mkDigit [x1] = One x1 >> mkDigit [x1, x2] = Two x1 x2 >> mkDigit [x1, x2, x3] = Three x1 x2 x3 >> mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4 >> >> -- length xs <= 4 => mkRevDigit xs = mkDigit (reverse xs) >> mkRevDigit :: [a] -> Digit a >> mkRevDigit [x1] = One x1 >> mkRevDigit [x2, x1] = Two x1 x2 >> mkRevDigit [x3, x2, x1] = Three x1 x2 x3 >> mkRevDigit [x4, x3, x2, x1] = Four x1 x2 x3 x4 >> >> mkNodes :: Int -> [a] -> [Node a] >> mkNodes size (x1:x2:x3:xs) = Node3 size x1 x2 x3:mkNodes size xs >> >> -- length xs `mod` 3 == 0 => >> -- mkRevNodes size xs = reverse (mkNodes size (reverse xs)) >> mkRevNodes :: Int -> [a] -> [Node a] >> mkRevNodes size (x3:x2:x1:xs) = Node3 size x1 x2 x3:mkRevNodes size xs >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/a229bee8/attachment.html> From chneukirchen at gmail.com Sun Nov 23 17:04:43 2014 From: chneukirchen at gmail.com (Christian Neukirchen) Date: Sun, 23 Nov 2014 18:04:43 +0100 Subject: [Haskell-cafe] Munich Haskell Meeting, 2014-11-26 @ 19:30 Message-ID: <87mw7hetlg.fsf@gmail.com> Dear all, next week, on Wednesday, 26th of November, our monthly Munich Haskell Meeting will take place again at Cafe Puck at 19:30 CET. For details see here: http://www.haskell-munich.de/dates Since Heinrich is not around much in Munich anymore, I have taken over organizing our Haskell meeting. The website will be updated soon. For the meantime, if you plan to join, please add yourself to this dudle so we can reserve enough seats: https://dudle.inf.tu-dresden.de/haskell-munich-nov-2014/ Everybody is welcome! Looking forward to see you, -- Christian Neukirchen <chneukirchen at gmail.com> http://chneukirchen.org From martin.drautzburg at web.de Sun Nov 23 17:04:37 2014 From: martin.drautzburg at web.de (martin) Date: Sun, 23 Nov 2014 18:04:37 +0100 Subject: [Haskell-cafe] Replacing the world in a State Machine with IO Message-ID: <547213A5.90803@web.de> Hello all, at my shop some folks are implementing things using a java tool called "activiti". AFAIK, they create a bunch of processes and a "process engine" takes care of activating or deactivating processes. Among the things which can cause a state transition are external events. I wonder how one could do this in haskell. (1) Async IO I thought the collection of all process states can be seen as the system state of a state machine. Some state transitions can be done without doing IO, e.g. in situations where the termination of one processes immediatlely activates another process. However other transitions block and occur as soon as an external event is received. Yet other transitions occur WHENEVER an external event gets received. I suppose I could handle this using threads, but I don't trust threads. They look simple first, but then the trouble they cause typically exceeds my worst expectations. My primary problem is that I haven't yet found a proper way to fully capture the problem. It appears to me that a state machine without IO is essentially a discrete event simulation. A state machine where ALL state transitions are triggered by IO also seems easy, everything would be blocking and I just dispatch external events. But I cannot picture a state machine where some (but not all) transitions are triggered by IO. (2) Replacing the real world In the long run, I'd like to replace the "world" from which these events originate by a simulated world. This should allow the process engine to proceeed in fast motion. I suppose I will then also make the clock part of the simulated world. This raises the question: how does one replace IO? The simulated world will not do any real IO (but still communicate to the process engine). Considering that "IO a" basically means "World -> (World, a)" this should be easy, but I cannot see how to get a hold on "World". If someone could give my thoughts a push in the right direction, I'd much appreciate it. From agocorona at gmail.com Sun Nov 23 18:01:48 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Sun, 23 Nov 2014 19:01:48 +0100 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> Message-ID: <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> I Sean. I saw your message in the gmail spam shortly after sending my response. Knowing how the gmail spam detection works based on other's behaviours, maybe someone don?t like to read it ;)) If that is the case, less they would like to read my response in the mentioned thread: Hi Sean, I knew [1] in a discussion here about the same topic. https://www.haskell.org/pipermail/haskell-cafe/2013-April/107799.html As a consequence of that I created the ticket. I expected that the end of the research was some results applied to a major haskell compiler, specially GHC to really solve the problem. I know that this was the intention of the authors And they said so in the discussion. But given the evident lack of interest of the Haskell community from the day one, specially the ones supposedly interested in the success of Haskell on industry and given the natural tendency of academic research to waste valuable efforts when there is no clear incentives by the industry, I suspect that the work will stay as such: research. I suspect that the authors are as disappointed as me. It is so evident that this is THE problem of Haskell, the main barrier that precludes entering by storm in the industry in the form of hundred of EDSLs, and is so evident the lack of interest of anyone in the Haskell community that I can`t say more. That is why I mention this tangentially in this corner of the discussion group. This way many people can read this and pretend that they have not. I know that computer science and science are driven by the same forces that drive everything else in human affairs. Academics well being is not challenged by niche and marginal industries that may drain some postdocs, but fear that the heavy IT industry would pollute their bucolic green pastures, well watered by state subsidies. In the other side, I understand that niche industries are not interested in solving this issue, since they have their own haskell experts. But the reason why Microsoft or, in a lesser extent, FP complete does not push to solve the issue is beyond my understanding. 2014-11-23 0:01 GMT+01:00 Sean Seefried <sean.seefried at gmail.com>: > If the list doesn't mind I'm reposting my reply to Alberto G. Corona in > under the thread "Monads: external questions" as a new message since the > topic has changed enough. > > ------------- > > Hi Alberto, > > I've been interested in domain specific error messages for years and I > agree with you that it is one of the major things holding back the utility > of DSLs to novice programmers. This is a shame since one of the touted > benefits of DSLs is that they *can* be used by novices with a minimum of > training, which is simply not true in the presence of error messages that > require detailed knowledge of Haskell to understand. > > I'd caution against saying that there is a lack of interest in that ticket > you linked to. It's still a research level problem despite the fact that > some great work has been done on it already. Incidentally, the author of > "Scripting the Type Inference Process" went on to do an entire PhD on the > topic entitled "Top Quality Type Error Messages"[2]. I recently wrote him > an email and he told me that the constraint-based type inference framework > that he used in the thesis, TOP, is available on Hackage [3]. > > Recently I noticed that this problem is already being worked on in Idris. > See "Reflect on your Mistakes!" [4] and some code on GitHub [5]. > > Perhaps we can get people interested in this feature again? > > Cheers, > > Sean > [1] http://www.open.ou.nl/bhr/heeren-scripting.pdf > [2] http://www.open.ou.nl/bhr/TopQuality.pdf > [3] https://hackage.haskell.org/package/Top > [4] http://www.itu.dk/people/drc/drafts/error-reflection-submission.pdf > [5] https://gist.github.com/david-christiansen/8349698 > > > On Sun Nov 23 2014 at 3:57:10 AM Alberto G. Corona <agocorona at gmail.com> > wrote: > >> Michael: >> >> You are right, but these are minor problems I think, compared with the >> huge potential advantages. >> >> I can not believe it when a slow immature language like Ruby could take >> over web development just for one library, Rails and some buzzwords, when a >> faster, safer language can do it millions of times better. Haskell can >> revolutionize all the industry simply selling it not as one more language, >> but as THE meta-language for building EDSLs for each domain problem. some >> EDSLs so close to the domain problem that can be used by non-programmers. >> >> That lack of vision and effort in the side of the haskell community hurts >> me. And the lack of interest in this ticket >> >> https://ghc.haskell.org/trac/ghc/ticket/7870 >> >> Is a clear display of this lack of interest. it is like the Aristocracy >> of the Haskell Wondwerland fears to be hijacked by hordes of mediocre DSL >> villains from the industry, so it is necessary to keep the walls high >> >> Haskell is a language dominated by academics that has no interest in the >> success of Haskell. On the contrary. >> >> 2014-10-29 15:13 GMT+01:00 Michael Jones <mike at proclivis.com>: >> >>> When I took a Lambda Calculus class years ago in Silicon Valley, 90% of >>> the students groaned and complained. They just wanted to learn Java and >>> make money. Having a background in OO design and experience with Eiffel, I >>> was intrigued and stuck with it, building some tools with ML, and later >>> Haskell. >>> >>> In the workplace it was near impossible to avoid the .Net culture, and >>> most of my code has been C#. But the factors that mattered were: >>> >>> - Continuity with past languages and tools >>> - Availability of programmers >>> - Third party libraries >>> - Inter langage operability >>> - Reuse of legacy code >>> >>> etc >>> >>> Best I can tell, there is no way to avoid the business context. I >>> suggest that if you have freedom, you need to be multilingual. Many systems >>> could benefit from applying the proper tool to the corresponding problem. >>> >>> But I will say this, becoming proficient at Haskell really improved my >>> designs by providing an alternative conceptual framework. But, it had a >>> very substantial learning curve. All I can say is trust that even if your >>> core language is procedural, you will be better at that for learning a >>> functional language. >>> >>> To make Haskell a first class citizen in the IT shops, I think focus >>> would have to shift more to the business context and needs. And certainly >>> more focus in the universities that are still dominated by procedural >>> languages. Once that is drilled into ones head, it affects the way one >>> thinks. >>> >>> To give an example, I have these problems: >>> >>> - Update to GHC 7.8.3 from 7.6 caused run time behavior changes breaking >>> USB application >>> - Sandboxes are not completely isolated from the core library and often >>> builds break >>> - Most new grads don?t even know what a functional language is >>> - Documentation gets out of sync with releases (where documentation >>> means Wiki and web) >>> - FFI is difficult to use and debug >>> - Lack of books, user groups, etc >>> >>> Mike >>> >>> On Oct 29, 2014, at 3:48 AM, Alberto G. Corona <agocorona at gmail.com> >>> wrote: >>> >>> I know that I'm using a different language when talking about monads. >>> The language of the IT industry. >>> >>> Many haskellers use the language for toy programming. Others are >>> professional academics. The few that use the language for commercial >>> purposes are too busy developing practical applications rather than >>> thinking deep about how to apply the haskell concepts to their problems. >>> As a result many of such problems remains essentially unsolved. These busy >>> developers try to transcode solutions from other languages that lack the >>> deep and expressiveness of Haskell. >>> >>> This lack of interest in one side and the lack of time in the other is >>> disappointing. The symptoms are everywhere. Particularly, I find it in the >>> lack of support and interests for this ticket: >>> >>> https://ghc.haskell.org/trac/ghc/ticket/7870 >>> >>> I though that there was definitively a shift from "avoid success at all >>> costs" a few years ago, for a commitment for the success, but still there >>> are many minds to change, especially the brilliant ones. >>> >>> 2014-10-26 2:02 GMT+01:00 Alberto G. Corona <agocorona at gmail.com>: >>> >>>> >>>> >>>> 2014-10-26 1:23 GMT+02:00 Jeffrey Brown <jeffbrown.the at gmail.com>: >>>> >>>>> As opposed to the internal logic of monads, how they work, I hope to >>>>> start a discussion about their external logic: how and why to use monads. >>>>> >>>>> design >>>>> ------ >>>>> How do monads change the way one >>>>> * thinks about a problem? >>>>> * structures data? >>>>> * refactors? >>>>> * tests? >>>>> Should I always be giving the monads a lot of cognitive bandwidth, >>>>> because they reorder the way everything should be, or is it an investment >>>>> with a high initial cognitive cost but requiring little maintenance >>>>> thereafter? >>>>> >>>>> what is their common framework? >>>>> ------------------------------- >>>>> Monads let data reach farther than it otherwise would. Subjectively, >>>>> they feel like a controlled way of violating encapsulation. >>>>> >>>>> Are there other, deeper or more specific, commonalities that explain >>>>> why monads are a good way to implement exceptions, output, state, and >>>>> perhaps other services? >>>>> >>>> >>>> I made monads for execution state recovery, web navigation.. workflows, >>>> long running transactions, backtracking, traceback and event chaining in >>>> web browser applications. >>>> >>>> I?m confident that the perspectives for monads to solve real IT >>>> problems are very promising. And when I mean monad I mean all the >>>> associated stuff : applicative, alternative etc. >>>> >>>> I?m confident that there will be a cloud monad (for chaining jobs and >>>> work distribution) an orchestration monad for orchestration of web services >>>> etc. >>>> >>>> There are problems that are intrinsically procedural among them, almost >>>> all problems in IT. instead of using ad-hoc data/control structures like >>>> events, handlers, configurations, routes, exceptions, logs, transaction >>>> compensations, promises ....the list goes on and on , the monad is the >>>> common control structure that can subsume all of them inside his >>>> programmable semicolon >>>> >>>> So, once the monad is set up, the user of the monad code the solution >>>> for the domain problem in a clean EDSL with absolutely no plumbing, at the >>>> level of the problem. so anyone that know the problem can understand the >>>> code. >>>> >>>> Is the monad instance, and the applicative etc the ones that subsume >>>> under the hood the special data/control structure necessary for the domain >>>> problem. >>>> >>>> >>>> Often if your code is general enough, it can be used in any monad. So >>>> you benefit from this. I think that in th future there will be a lot of >>>> surprises about the shareability of code between monads when the IT >>>> industry start to use them seriously. I think that we are just at the >>>> beginning. >>>> >>>> I hope that some others of your questions are also answered here >>>> >>> >>> >>> >>> -- >>> Alberto. >>> >>> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/bc4903a0/attachment.html> From eir at cis.upenn.edu Sun Nov 23 19:36:32 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 23 Nov 2014 14:36:32 -0500 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> Message-ID: <EF4F8F60-E24B-4FF9-A77C-2D85F71CD0E4@cis.upenn.edu> Thanks for breaking this discussion out with a fresh subject line, or otherwise I would not have seen it. As an active GHC developer and budding academic, I thought I could share my views on this subject: Please please please let's do this! (This = come up with a way for better error messages in EDSLs.) I've never heard anyone say the lack of customizable error messages is an insignificant or unimportant problem. Nor am I familiar with any efforts to redirect or stymie such work. However, I completely agree that nothing is getting done. The problem I see here is a false underlying assumption: "If the community wants to do X, then X will get done." This assumption, on the surface, seems reasonable enough. However, it seems to apply most in a resource-rich community. For better or worse, Haskell/GHC today is not particularly resource-rich, in the resource that counts: developer-hours. As far as I know, there is precisely one person whose day job is to work on GHC (Austin Seipp). The rest of the work is "volunteer". I put "volunteer" in quotes because the rest of us get compensated in various ways for our contributions. My personal compensation (along with the happiness of contributing to an open-source project) is that working on GHC makes my research more relevant and more interesting. Because I work on GHC and can claim to have released my research, I estimate that it's more likely that my papers get accepted for publication. This creates a nice incentive for me to work on GHC. And I'm happy to do so -- it's also plenty of fun. But, there is very little incentive for me, personally, right now, to dive into the worthy cause of error message customization, because that topic is only loosely related to my primary research thrust, which is dependent types. I imagine that a similar incentive structure exists for other GHC contributors. And so, we wait for someone to come along and fix the problem. Going back to the original, false assumption: yes, I believe that the community wants error message customization, but currently no appropriately-motivated individual wants it and has the time to spend making it happen. So, to those of you who really want this feature: design and implement it! And, to those of you working for businesses that would benefit from this feature: incentivize (that is, pay) someone to design and implement it! I, for one, would welcome either development with open arms. Richard On Nov 23, 2014, at 1:01 PM, Alberto G. Corona <agocorona at gmail.com> wrote: > I Sean. I saw your message in the gmail spam shortly after sending my response. Knowing how the gmail spam detection works based on other's behaviours, maybe someone don?t like to read it ;)) > > If that is the case, less they would like to read my response in the mentioned thread: > > Hi Sean, > > I knew [1] in a discussion here about the same topic. > > https://www.haskell.org/pipermail/haskell-cafe/2013-April/107799.html > > As a consequence of that I created the ticket. I expected that the end of the research was some results applied to a major haskell compiler, specially GHC to really solve the problem. I know that this was the intention of the authors And they said so in the discussion. > > But given the evident lack of interest of the Haskell community from the day one, specially the ones supposedly interested in the success of Haskell on industry and given the natural tendency of academic research to waste valuable efforts when there is no clear incentives by the industry, I suspect that the work will stay as such: research. > > I suspect that the authors are as disappointed as me. It is so evident that this is THE problem of Haskell, the main barrier that precludes entering by storm in the industry in the form of hundred of EDSLs, and is so evident the lack of interest of anyone in the Haskell community that I can`t say more. That is why I mention this tangentially in this corner of the discussion group. This way many people can read this and pretend that they have not. > > I know that computer science and science are driven by the same forces that drive everything else in human affairs. Academics well being is not challenged by niche and marginal industries that may drain some postdocs, but fear that the heavy IT industry would pollute their bucolic green pastures, well watered by state subsidies. > > In the other side, I understand that niche industries are not interested in solving this issue, since they have their own haskell experts. But the reason why Microsoft or, in a lesser extent, FP complete does not push to solve the issue is beyond my understanding. > > > > 2014-11-23 0:01 GMT+01:00 Sean Seefried <sean.seefried at gmail.com>: > If the list doesn't mind I'm reposting my reply to Alberto G. Corona in under the thread "Monads: external questions" as a new message since the topic has changed enough. > > ------------- > > Hi Alberto, > > I've been interested in domain specific error messages for years and I agree with you that it is one of the major things holding back the utility of DSLs to novice programmers. This is a shame since one of the touted benefits of DSLs is that they *can* be used by novices with a minimum of training, which is simply not true in the presence of error messages that require detailed knowledge of Haskell to understand. > > I'd caution against saying that there is a lack of interest in that ticket you linked to. It's still a research level problem despite the fact that some great work has been done on it already. Incidentally, the author of "Scripting the Type Inference Process" went on to do an entire PhD on the topic entitled "Top Quality Type Error Messages"[2]. I recently wrote him an email and he told me that the constraint-based type inference framework that he used in the thesis, TOP, is available on Hackage [3]. > > Recently I noticed that this problem is already being worked on in Idris. See "Reflect on your Mistakes!" [4] and some code on GitHub [5]. > > Perhaps we can get people interested in this feature again? > > Cheers, > > Sean > [1] http://www.open.ou.nl/bhr/heeren-scripting.pdf > [2] http://www.open.ou.nl/bhr/TopQuality.pdf > [3] https://hackage.haskell.org/package/Top > [4] http://www.itu.dk/people/drc/drafts/error-reflection-submission.pdf > [5] https://gist.github.com/david-christiansen/8349698 > > > On Sun Nov 23 2014 at 3:57:10 AM Alberto G. Corona <agocorona at gmail.com> wrote: > Michael: > > You are right, but these are minor problems I think, compared with the huge potential advantages. > > I can not believe it when a slow immature language like Ruby could take over web development just for one library, Rails and some buzzwords, when a faster, safer language can do it millions of times better. Haskell can revolutionize all the industry simply selling it not as one more language, but as THE meta-language for building EDSLs for each domain problem. some EDSLs so close to the domain problem that can be used by non-programmers. > > That lack of vision and effort in the side of the haskell community hurts me. And the lack of interest in this ticket > > https://ghc.haskell.org/trac/ghc/ticket/7870 > > Is a clear display of this lack of interest. it is like the Aristocracy of the Haskell Wondwerland fears to be hijacked by hordes of mediocre DSL villains from the industry, so it is necessary to keep the walls high > > Haskell is a language dominated by academics that has no interest in the success of Haskell. On the contrary. > > 2014-10-29 15:13 GMT+01:00 Michael Jones <mike at proclivis.com>: > When I took a Lambda Calculus class years ago in Silicon Valley, 90% of the students groaned and complained. They just wanted to learn Java and make money. Having a background in OO design and experience with Eiffel, I was intrigued and stuck with it, building some tools with ML, and later Haskell. > > In the workplace it was near impossible to avoid the .Net culture, and most of my code has been C#. But the factors that mattered were: > > - Continuity with past languages and tools > - Availability of programmers > - Third party libraries > - Inter langage operability > - Reuse of legacy code > > etc > > Best I can tell, there is no way to avoid the business context. I suggest that if you have freedom, you need to be multilingual. Many systems could benefit from applying the proper tool to the corresponding problem. > > But I will say this, becoming proficient at Haskell really improved my designs by providing an alternative conceptual framework. But, it had a very substantial learning curve. All I can say is trust that even if your core language is procedural, you will be better at that for learning a functional language. > > To make Haskell a first class citizen in the IT shops, I think focus would have to shift more to the business context and needs. And certainly more focus in the universities that are still dominated by procedural languages. Once that is drilled into ones head, it affects the way one thinks. > > To give an example, I have these problems: > > - Update to GHC 7.8.3 from 7.6 caused run time behavior changes breaking USB application > - Sandboxes are not completely isolated from the core library and often builds break > - Most new grads don?t even know what a functional language is > - Documentation gets out of sync with releases (where documentation means Wiki and web) > - FFI is difficult to use and debug > - Lack of books, user groups, etc > > Mike > > On Oct 29, 2014, at 3:48 AM, Alberto G. Corona <agocorona at gmail.com> wrote: > >> I know that I'm using a different language when talking about monads. The language of the IT industry. >> >> Many haskellers use the language for toy programming. Others are professional academics. The few that use the language for commercial purposes are too busy developing practical applications rather than thinking deep about how to apply the haskell concepts to their problems. As a result many of such problems remains essentially unsolved. These busy developers try to transcode solutions from other languages that lack the deep and expressiveness of Haskell. >> >> This lack of interest in one side and the lack of time in the other is disappointing. The symptoms are everywhere. Particularly, I find it in the lack of support and interests for this ticket: >> >> https://ghc.haskell.org/trac/ghc/ticket/7870 >> >> I though that there was definitively a shift from "avoid success at all costs" a few years ago, for a commitment for the success, but still there are many minds to change, especially the brilliant ones. >> >> 2014-10-26 2:02 GMT+01:00 Alberto G. Corona <agocorona at gmail.com>: >> >> >> 2014-10-26 1:23 GMT+02:00 Jeffrey Brown <jeffbrown.the at gmail.com>: >> As opposed to the internal logic of monads, how they work, I hope to start a discussion about their external logic: how and why to use monads. >> >> design >> ------ >> How do monads change the way one >> * thinks about a problem? >> * structures data? >> * refactors? >> * tests? >> Should I always be giving the monads a lot of cognitive bandwidth, because they reorder the way everything should be, or is it an investment with a high initial cognitive cost but requiring little maintenance thereafter? >> >> what is their common framework? >> ------------------------------- >> Monads let data reach farther than it otherwise would. Subjectively, they feel like a controlled way of violating encapsulation. >> >> Are there other, deeper or more specific, commonalities that explain why monads are a good way to implement exceptions, output, state, and perhaps other services? >> >> I made monads for execution state recovery, web navigation.. workflows, long running transactions, backtracking, traceback and event chaining in web browser applications. >> >> I?m confident that the perspectives for monads to solve real IT problems are very promising. And when I mean monad I mean all the associated stuff : applicative, alternative etc. >> >> I?m confident that there will be a cloud monad (for chaining jobs and work distribution) an orchestration monad for orchestration of web services etc. >> >> There are problems that are intrinsically procedural among them, almost all problems in IT. instead of using ad-hoc data/control structures like events, handlers, configurations, routes, exceptions, logs, transaction compensations, promises ....the list goes on and on , the monad is the common control structure that can subsume all of them inside his programmable semicolon >> >> So, once the monad is set up, the user of the monad code the solution for the domain problem in a clean EDSL with absolutely no plumbing, at the level of the problem. so anyone that know the problem can understand the code. >> >> Is the monad instance, and the applicative etc the ones that subsume under the hood the special data/control structure necessary for the domain problem. >> >> >> Often if your code is general enough, it can be used in any monad. So you benefit from this. I think that in th future there will be a lot of surprises about the shareability of code between monads when the IT industry start to use them seriously. I think that we are just at the beginning. >> >> I hope that some others of your questions are also answered here >> >> >> >> -- >> Alberto. > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > > > -- > Alberto. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/986ed643/attachment.html> From yom at artyom.me Sun Nov 23 19:42:18 2014 From: yom at artyom.me (Artyom) Date: Sun, 23 Nov 2014 22:42:18 +0300 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> Message-ID: <5472389A.8030503@artyom.me> On 11/23/2014 09:01 PM, Alberto G. Corona wrote: It is so evident that this is THE problem of Haskell Unfortunately, it?s not evident. Note that I?m /not/ saying it?s not ?the? problem of Haskell; merely that * I consider myself to be somewhat intelligent * and ? without having put much thought into this question ? I don?t find it evident at all that the incomprehensibility of error messages arising when using DSLs is ?probably the biggest barrier for the acceptance of Haskell on Industry? Therefore, unless you?re sure for some reason that I?m an outlier and the majority of programmers /do/ find it evident but prefer to pretend they don?t (for pragmatic, evil, or other reasons), I would suggest writing an article attempting to persuade the community that it?s indeed a major problem ? or, better yet, the problem which has the biggest utility/complexity-of-implementation ratio. I remember that what got me into Haskell was simply a handful of ?mind-blowing? examples ? an easily readable parser in a few lines of code, the elegance of |map| versus a |for| loop, things like that. A post with side-by-side comparisons of real-world GHC error messages arising when working with various DSLs (parsec, attoparsec, blaze, binary, diagrams, etc.) vs. mockups of improved error messages, alongside with a section describing the current research done in this direction and outlining general ideas/concepts, would probably do the trick. ? From wojciech.danilo at gmail.com Sun Nov 23 20:42:28 2014 From: wojciech.danilo at gmail.com (Wojciech Danilo) Date: Sun, 23 Nov 2014 20:42:28 +0000 Subject: [Haskell-cafe] Domain specific error messages References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> <5472389A.8030503@artyom.me> Message-ID: <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> Richard - did you think about some way of funding Haskell development? I think a lot of people are talking about low people-hours spend on GHC, but nobody ever told that a good solution here will be funding of its development. We've got so many options here - dotations, companies, vc's, community funding (maybe even kickstarter). You know, this would help MUCH Haskell and overall - everyone from this community. But in general - people are not working this way, that if somebody will tell - this is a good idea, everybody woudl do it. I'm writing exactly to you, because you are somebody very close to GHC and we all see, you "want" to do something good. Why not get funding for Haskell and GHC? I would love to help, really - as much as I can. But if everyone agree, we have to do something with it, as fast as possbile, othercase, Haskell will slowly die - taking in consideration how much moneyu is put in Scala, Go etc. These languages are getting better everyday - and of course, they've got another asusmptions than the best programming language I've been suing in my life, they have got many man-hours more spend on development than we do. What do you think? All the best, Wojciech Sun Nov 23 2014 at 8:42:29 PM u?ytkownik Artyom <yom at artyom.me> napisa?: > On 11/23/2014 09:01 PM, Alberto G. Corona wrote: > > It is so evident that this is THE problem of Haskell > > Unfortunately, it?s not evident. Note that I?m /not/ saying it?s not > ?the? problem of Haskell; merely that > > * > > I consider myself to be somewhat intelligent > > * > > and ? without having put much thought into this question ? I don?t > find it evident at all that the incomprehensibility of error > messages arising when using DSLs is ?probably the biggest barrier > for the acceptance of Haskell on Industry? > > Therefore, unless you?re sure for some reason that I?m an outlier and > the majority of programmers /do/ find it evident but prefer to pretend > they don?t (for pragmatic, evil, or other reasons), I would suggest > writing an article attempting to persuade the community that it?s indeed > a major problem ? or, better yet, the problem which has the biggest > utility/complexity-of-implementation ratio. I remember that what got me > into Haskell was simply a handful of ?mind-blowing? examples ? an easily > readable parser in a few lines of code, the elegance of |map| versus a > |for| loop, things like that. A post with side-by-side comparisons of > real-world GHC error messages arising when working with various DSLs > (parsec, attoparsec, blaze, binary, diagrams, etc.) vs. mockups of > improved error messages, alongside with a section describing the current > research done in this direction and outlining general ideas/concepts, > would probably do the trick. > > ? > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/a2125552/attachment.html> From sean.seefried at gmail.com Sun Nov 23 23:57:32 2014 From: sean.seefried at gmail.com (Sean Seefried) Date: Sun, 23 Nov 2014 23:57:32 +0000 Subject: [Haskell-cafe] Programming videogames in haskell References: <5466aba1.6b45440a.5a19.ffffa05b@mx.google.com> <op.xpe5bgpbpz0j5l@alquantor> Message-ID: <CAOfQma8PQ=vJS2+etuxsWQV5rBiY+3Y4VkbsG9tmgbvHUMEirA@mail.gmail.com> I just updated the wiki [1] with a build script I wrote in Docker [2]. Putting together the build script in Docker was a very pleasant experience. I broke the script up into many small pieces so that if one particular part failed I could simply go back to the last checkpoint and start from there. Once I had finished the script, I also had very high assurance that it would work with no problems whatsoever when I ran it again from scratch. Normally putting together build scripts is difficult because of the inherently stateful nature of a file system. If you are working on a build script that takes a long time to run the temptation is not to start again from scratch every time something goes wrong. The turn-around times are simply too long. You can't be waiting 50 minutes every time you make a small change. Therein lies madness. But because Docker uses a copy-on-write filesystem under the hood, the filesystem is really a kind of persistent data structure. When one particular part of the script failed I was able to go back to *exactly* the state it was in before it failed. The boon to my productivity and my sanity was immense. Sean [1] https://www.haskell.org/haskellwiki/Android [2] https://github.com/sseefried/docker-build-ghc-android -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/7eb51190/attachment.html> From sean.seefried at gmail.com Mon Nov 24 06:47:54 2014 From: sean.seefried at gmail.com (Sean Seefried) Date: Mon, 24 Nov 2014 06:47:54 +0000 Subject: [Haskell-cafe] Programming videogames in haskell References: <5466aba1.6b45440a.5a19.ffffa05b@mx.google.com> <op.xpe5bgpbpz0j5l@alquantor> <CAOfQma8PQ=vJS2+etuxsWQV5rBiY+3Y4VkbsG9tmgbvHUMEirA@mail.gmail.com> Message-ID: <CAOfQma-rwc9DsOdnPZKDu24YZC=raZwtJ3yktQ=50AZ3WhQhDQ@mail.gmail.com> I've now pushed the image to the Docker Hub. Pull it with: $ docker pull sseefried/debian-stable-ghc-android On Mon Nov 24 2014 at 10:57:31 AM Sean Seefried <sean.seefried at gmail.com> wrote: > I just updated the wiki [1] with a build script I wrote in Docker [2]. > > Putting together the build script in Docker was a very pleasant > experience. I broke the script up into many small pieces so that if one > particular part failed I could simply go back to the last checkpoint and > start from there. Once I had finished the script, I also had very high > assurance that it would work with no problems whatsoever when I ran it > again from scratch. > > Normally putting together build scripts is difficult because of the > inherently stateful nature of a file system. If you are working on a build > script that takes a long time to run the temptation is not to start again > from scratch every time something goes wrong. The turn-around times are > simply too long. You can't be waiting 50 minutes every time you make a > small change. Therein lies madness. But because Docker uses a copy-on-write > filesystem under the hood, the filesystem is really a kind of persistent > data structure. When one particular part of the script failed I was able to > go back to *exactly* the state it was in before it failed. The boon to my > productivity and my sanity was immense. > > Sean > > [1] https://www.haskell.org/haskellwiki/Android > [2] https://github.com/sseefried/docker-build-ghc-android > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/7b80d645/attachment-0001.html> From trupill at gmail.com Mon Nov 24 08:27:20 2014 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Mon, 24 Nov 2014 09:27:20 +0100 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> <5472389A.8030503@artyom.me> <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> Message-ID: <CAHnFXOs1p2GzwNj3Pi_qZJemGdKH2eCP2VfM_hdq1mXBpGYTzg@mail.gmail.com> At Utrecht University we are currently tackling this problem, in the form of the DOMain Specific Type Error Diagnosis (DOMSTED) Project [1]. So at least we have one person (me) working full-time on it, plus my supervisor Jurriaan Hage, which had already worked in a similar project for Haskell 98 which produced the Helium [2] compiler. We are slowly building step towards a nice way to create domain specific error messages, and we expect to have some nice results soon :) Of course, if you have any ideas on how to improve error messages, feel free to contact me :) Alejandro. [1] http://www.cs.uu.nl/research/techreps/repo/CS-2014/2014-019.pdf [2] http://hackage.haskell.org/package/helium 2014-11-23 21:42 GMT+01:00 Wojciech Danilo <wojciech.danilo at gmail.com>: > Richard - did you think about some way of funding Haskell development? I > think a lot of people are talking about low people-hours spend on GHC, but > nobody ever told that a good solution here will be funding of its > development. We've got so many options here - dotations, companies, vc's, > community funding (maybe even kickstarter). You know, this would help MUCH > Haskell and overall - everyone from this community. But in general - people > are not working this way, that if somebody will tell - this is a good idea, > everybody woudl do it. I'm writing exactly to you, because you are somebody > very close to GHC and we all see, you "want" to do something good. Why not > get funding for Haskell and GHC? I would love to help, really - as much as > I can. But if everyone agree, we have to do something with it, as fast as > possbile, othercase, Haskell will slowly die - taking in consideration how > much moneyu is put in Scala, Go etc. These languages are getting better > everyday - and of course, they've got another asusmptions than the best > programming language I've been suing in my life, they have got many > man-hours more spend on development than we do. > What do you think? > > All the best, > Wojciech > > Sun Nov 23 2014 at 8:42:29 PM u?ytkownik Artyom <yom at artyom.me> napisa?: > > On 11/23/2014 09:01 PM, Alberto G. Corona wrote: >> >> It is so evident that this is THE problem of Haskell >> >> Unfortunately, it?s not evident. Note that I?m /not/ saying it?s not >> ?the? problem of Haskell; merely that >> >> * >> >> I consider myself to be somewhat intelligent >> >> * >> >> and ? without having put much thought into this question ? I don?t >> find it evident at all that the incomprehensibility of error >> messages arising when using DSLs is ?probably the biggest barrier >> for the acceptance of Haskell on Industry? >> >> Therefore, unless you?re sure for some reason that I?m an outlier and >> the majority of programmers /do/ find it evident but prefer to pretend >> they don?t (for pragmatic, evil, or other reasons), I would suggest >> writing an article attempting to persuade the community that it?s indeed >> a major problem ? or, better yet, the problem which has the biggest >> utility/complexity-of-implementation ratio. I remember that what got me >> into Haskell was simply a handful of ?mind-blowing? examples ? an easily >> readable parser in a few lines of code, the elegance of |map| versus a >> |for| loop, things like that. A post with side-by-side comparisons of >> real-world GHC error messages arising when working with various DSLs >> (parsec, attoparsec, blaze, binary, diagrams, etc.) vs. mockups of >> improved error messages, alongside with a section describing the current >> research done in this direction and outlining general ideas/concepts, >> would probably do the trick. >> >> ? >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/c605e7a7/attachment.html> From wojtek at power.com.pl Mon Nov 24 09:09:35 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Mon, 24 Nov 2014 10:09:35 +0100 Subject: [Haskell-cafe] Replacing the world in a State Machine with IO In-Reply-To: <547213A5.90803@web.de> References: <547213A5.90803@web.de> Message-ID: <5472F5CF.5050006@power.com.pl> On 23.11.2014 18:04, martin wrote: > at my shop some folks are implementing things using a java tool called "activiti". AFAIK, they create a bunch of > processes and a "process engine" takes care of activating or deactivating processes. Among the things which can cause a > state transition are external events. I wonder how one could do this in haskell. > Like a like a mini operating system: processes and their scheduler? Perhaps take a look at the following: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.39.8039 http://repository.upenn.edu/cgi/viewcontent.cgi?article=1391&context=cis_papers http://www.haskellforall.com/2013/06/from-zero-to-cooperative-threads-in-33.html > I suppose I could handle this using threads, but I don't trust threads. They look simple first, but then the trouble > they cause typically exceeds my worst expectations. In Erlang you woudn't think much and use (lightweight) processes and message passing. You can do the same in Haskell, just don't use global state, use channels instead. I also recall https://hackage.haskell.org/package/aivika, discrete event simulation library, but I don't know if it is related. -- Wojtek From tanielsen at gmail.com Mon Nov 24 12:05:52 2014 From: tanielsen at gmail.com (Tom Nielsen) Date: Mon, 24 Nov 2014 12:05:52 +0000 Subject: [Haskell-cafe] suggestions about a library for numerical calculation In-Reply-To: <CA+AeLgQQOObFum95OcASKZaAXqQVdiBYf4wtqOhLeN4NNmaGPA@mail.gmail.com> References: <CA+AeLgQQOObFum95OcASKZaAXqQVdiBYf4wtqOhLeN4NNmaGPA@mail.gmail.com> Message-ID: <CADDFi2UhGV2dgB8zGMK05E8zDk_7jdJGK1GC+gin4X5EzZhqkQ@mail.gmail.com> I'd say we're lacking in the optimization and classification department. While there are libraries for this, they are mostly bindings to C libraries which makes it more difficult to get information out of the algorithm. We have implemented BFGS and Nelder-mead here: https://github.com/glutamate/probably-baysig/tree/master/src/Math/Probably but that isn't officially open sourced (and lacking L-BFGS). We're also a lot of image processing now, and native Haskell implementations of SIFT and Gaussian mixture model fitting would be extremely useful. Tom On Thu, Nov 20, 2014 at 5:44 PM, felipe zapata <tifonzafel at gmail.com> wrote: > Hi all, > I want to develop some tools on top of Vector and Repa, and I've wondered > what tools could be useful that are not already on hmatrix. > > Any suggestions would be appreciated, > > Felipe Z. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/c0553721/attachment.html> From haskell-cafe at maartenfaddegon.nl Mon Nov 24 14:37:35 2014 From: haskell-cafe at maartenfaddegon.nl (Maarten Faddegon) Date: Mon, 24 Nov 2014 14:37:35 +0000 Subject: [Haskell-cafe] parallel and concurrent Haskell programs Message-ID: <547342AF.9020207@maartenfaddegon.nl> Hello Caf?, Recently I became interested in parallel and concurrent Haskell and I wonder if there are any non-trivial open-source programs that are recommended to have a look at? Thanks, Maarten Faddegon From alois.cochard at gmail.com Mon Nov 24 14:49:38 2014 From: alois.cochard at gmail.com (Alois Cochard) Date: Mon, 24 Nov 2014 14:49:38 +0000 Subject: [Haskell-cafe] parallel and concurrent Haskell programs In-Reply-To: <547342AF.9020207@maartenfaddegon.nl> References: <547342AF.9020207@maartenfaddegon.nl> Message-ID: <CAJHA+wpKahkvsgh9MaRSwDM+U-2+N1KQ+4MrwKjotakbwcZqeQ@mail.gmail.com> Hi Maarten, First I suppose that you know about the great book from Simon Marlow, I also found that paper very interesting to understand some low level aspects of the RTS: http://haskell.cs.yale.edu/wp-content/uploads/2013/08/hask035-voellmy.pdf Then, to actually respond to your question, I enjoyed looking into the code of some web servers to see how it's built: *Warp* http://www.aosabook.org/en/posa/warp.html https://github.com/yesodweb/wai/tree/master/warp/Network/Wai/Handler *Snap* https://github.com/snapframework/snap-server/tree/master/src/Snap/Internal/Http/Server Also, in a different category, *bronk* by Bryan O'Sullivan might be of inspiration: https://github.com/bos/pronk Good luck! On 24 November 2014 at 14:37, Maarten Faddegon < haskell-cafe at maartenfaddegon.nl> wrote: > Hello Caf?, > > Recently I became interested in parallel and concurrent Haskell and I > wonder if there are any non-trivial open-source programs that are > recommended to have a look at? > > Thanks, > > Maarten Faddegon > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -- *?\ois* http://twitter.com/aloiscochard http://github.com/aloiscochard -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/2386b3bf/attachment.html> From martin.drautzburg at web.de Mon Nov 24 15:22:49 2014 From: martin.drautzburg at web.de (martin) Date: Mon, 24 Nov 2014 16:22:49 +0100 Subject: [Haskell-cafe] Replacing IO with pure values Message-ID: <54734D49.3030308@web.de> Hello all, in order to nail down my problem state in "Replacing the world in a State Machine with IO", I'd like to answer a much simpler question: If I have function which reads IO and I want to test this function by passing it a series of pure values, how would I do this? I suppose I can do this by splitting my function in two, such that the outer function does IO and the inner is a pure function. Is there any other way? From corentin.dupont at gmail.com Mon Nov 24 16:25:13 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Mon, 24 Nov 2014 17:25:13 +0100 Subject: [Haskell-cafe] Replacing IO with pure values In-Reply-To: <54734D49.3030308@web.de> References: <54734D49.3030308@web.de> Message-ID: <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> This Stackoverflow give a lot of hints: http://stackoverflow.com/questions/7370073/testing-functions-in-haskell-that-do-io You cannot "Unit" test functions that performs, because by definition a unit test is about testing an isolated piece of code that give the same result for the same input, i.e. pure. In my programs I separate the non-IO parts for the IO parts, so that I can test the non-IO parts. The IO parts are mainly the GUI parts of my apps, which I test manually. Now it should be possible to trick the IO monad by supplying always the same user input to your function, but I don't know how to do that. On Mon, Nov 24, 2014 at 4:22 PM, martin <martin.drautzburg at web.de> wrote: > Hello all, > > in order to nail down my problem state in "Replacing the world in a State > Machine with IO", I'd like to answer a much > simpler question: > > If I have function which reads IO and I want to test this function by > passing it a series of pure values, how would I do > this? I suppose I can do this by splitting my function in two, such that > the outer function does IO and the inner is a > pure function. Is there any other way? > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/cf4291d6/attachment.html> From corentin.dupont at gmail.com Mon Nov 24 16:26:24 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Mon, 24 Nov 2014 17:26:24 +0100 Subject: [Haskell-cafe] Replacing IO with pure values In-Reply-To: <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> References: <54734D49.3030308@web.de> <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> Message-ID: <CAEyhvmqA1OTxVLTDpCoCoLj++wzzR1_igGPQKAWOmGchLjLgsQ@mail.gmail.com> This Stackoverflow give a lot of hints: http://stackoverflow.com/questions/7370073/testing-functions-in-haskell-that-do-io You cannot "Unit" test functions that performs IO, because by definition a unit test is about testing an isolated piece of code that give the same result for the same input, i.e. pure. In my programs I separate the non-IO parts for the IO parts, so that I can test the non-IO parts. The IO parts are mainly the GUI parts of my apps, which I test manually. Now it should be possible to trick the IO monad by supplying always the same user input to your function, but I don't know how to do that.t performs, because by definition a unit test is about testing an isolated piece of code that give the same result for the same input, i.e. pure. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/a106dd3f/attachment.html> From wojtek at power.com.pl Mon Nov 24 16:27:22 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Mon, 24 Nov 2014 17:27:22 +0100 Subject: [Haskell-cafe] Generating valid html In-Reply-To: <20141119084629.B5594C3841@www1.g3.pair.com> References: <20141119084629.B5594C3841@www1.g3.pair.com> Message-ID: <54735C6A.9010303@power.com.pl> On 19.11.2014 09:46, oleg at okmij.org wrote: > Somewhat related is the HSXML library for generating valid XML and > HTML. To be precise, the library is designed to express in the type > system content model constraints such as: block-level elements like DIV > are allowed only in the block-level context; one cannot put DIV within > H1, for example. Some items may be polymorphic: for example, TITLE > appears in HEAD, it can be an attribute and it can be an element. It > can be rendered differently in each case. The same HSXML document may > be rendered as HTML or XML (or something else entirely, e.g., PDF). > > http://okmij.org/ftp/Scheme/xml.html#typed-SXML > Very nice syntax, but I have yet to figure out how it works. BTW the error messages are "funny", as being discussed right now in another thread. -- Wojtek From felipe.lessa at gmail.com Mon Nov 24 16:37:29 2014 From: felipe.lessa at gmail.com (Felipe Lessa) Date: Mon, 24 Nov 2014 14:37:29 -0200 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CAHnFXOs1p2GzwNj3Pi_qZJemGdKH2eCP2VfM_hdq1mXBpGYTzg@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> <5472389A.8030503@artyom.me> <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> <CAHnFXOs1p2GzwNj3Pi_qZJemGdKH2eCP2VfM_hdq1mXBpGYTzg@mail.gmail.com> Message-ID: <54735EC9.1020902@gmail.com> On 24-11-2014 06:27, Alejandro Serrano Mena wrote: > At Utrecht University we are currently tackling this problem, in the > form of the DOMain Specific Type Error Diagnosis (DOMSTED) Project [1]. > So at least we have one person (me) working full-time on it, plus my > supervisor Jurriaan Hage, which had already worked in a similar project > for Haskell 98 which produced the Helium [2] compiler. > We are slowly building step towards a nice way to create domain specific > error messages, and we expect to have some nice results soon :) > Of course, if you have any ideas on how to improve error messages, feel > free to contact me :) It would be nice if you could ping relevant issues (such as [1]) stating that you're researching on this topic. Cheers, [1] https://ghc.haskell.org/trac/ghc/ticket/7870 -- Felipe. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: OpenPGP digital signature URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/e7bb2ff5/attachment.sig> From christiaan.baaij at gmail.com Mon Nov 24 17:49:32 2014 From: christiaan.baaij at gmail.com (Christiaan Baaij) Date: Mon, 24 Nov 2014 18:49:32 +0100 Subject: [Haskell-cafe] Dutch functional programming day (NL-FP 2015) Message-ID: <CABzw7bVTxO+t3phRDPADyjV89DHTRKuCjjStu1evTy1qKeSZ_g@mail.gmail.com> Dear all, The next Dutch Functional Programming day (NL-FP 2015) will take place on Friday, January 9, 2015 at the University of Twente, Enschede, The Netherlands. You are all cordially invited to participate and, of course, to give a presentation. The day will end with a joint dinner. *Request:* in order to make the necessary reservations, we would like to know as soon as possible how many people we may expect. More information, and the online registration form, can be found at: http://wwwhome.cs.utwente.nl/~jankuper/fp-dag/ Hope to meet you all in Twente at the next FP Day! Best regards, Christiaan Baaij -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/e3779202/attachment.html> From davidleothomas at gmail.com Mon Nov 24 20:03:27 2014 From: davidleothomas at gmail.com (David Thomas) Date: Mon, 24 Nov 2014 12:03:27 -0800 Subject: [Haskell-cafe] Replacing IO with pure values In-Reply-To: <CAEyhvmqA1OTxVLTDpCoCoLj++wzzR1_igGPQKAWOmGchLjLgsQ@mail.gmail.com> References: <54734D49.3030308@web.de> <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> <CAEyhvmqA1OTxVLTDpCoCoLj++wzzR1_igGPQKAWOmGchLjLgsQ@mail.gmail.com> Message-ID: <CAJUDvci1x87G7SkiesjrwHBpH3YhfCQh7858VwA1dpBTFjnhMQ@mail.gmail.com> Depending on your scope, one thing you could do is replace the things that operate against IO with functions that operate against some other interface, and then provide an IO-based implementation and a pure implementation of that interface. That works best where the IO activity is fairly simple; of course, when that's true you can often find ways to factor it out and just get yourself a pure function to test anyway. It works worst when you're calling out into complicated libraries that live in IO. There may be a sweet spot between these two where it would be a good fit. On Mon, Nov 24, 2014 at 8:26 AM, Corentin Dupont <corentin.dupont at gmail.com> wrote: > This Stackoverflow give a lot of hints: > http://stackoverflow.com/questions/7370073/testing-functions-in-haskell-that-do-io > > You cannot "Unit" test functions that performs IO, because by definition a > unit test is about testing an isolated piece of code that give the same > result for the same input, i.e. pure. > In my programs I separate the non-IO parts for the IO parts, so that I can > test the non-IO parts. > The IO parts are mainly the GUI parts of my apps, which I test manually. > > Now it should be possible to trick the IO monad by supplying always the same > user input to your function, but I don't know how to do that.t performs, > because by definition a unit test is about testing an isolated piece of code > that give the same result for the same input, i.e. pure. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From lars at hupel.info Mon Nov 24 20:28:48 2014 From: lars at hupel.info (Lars Hupel) Date: Mon, 24 Nov 2014 21:28:48 +0100 Subject: [Haskell-cafe] GHC: Discovery of source dependencies without --make Message-ID: <54739500.8010503@hupel.info> Hi everyone, I've got another problem in our ? admittedly complex ? build process (for context, see [0]). Anyway, I'm struggling with the following: I have an 'out' folder which contains .hi and .o files from previous compilation stages. I now want to compile a bunch of .hs files which depend on the modules from previous stages. I can just say ghc -c -iout -outputdir out File1.hs File2.hs ... which works nicely if File*.hs are independent of each other, or are already topologically sorted wrt dependencies. If not, compilation of 'File1.hs' will fail when importing 'File2'. However, I can't make it to work if I don't know their precise ordering in advance. I tried ghc -c --make -iout -outputdir out ... but apparently '--make' makes GHC ignore .hi files in the 'out' folder. (Not even '-hidir' makes it respect them.) Reading a bit further, I discovered the '-M' flag, however, not only does it output Makefile-formatted output, it also ignores .hi files. Is there any way to get the dependency discovery of '--make' without the rest? Or alternatively, to get '--make' to not just respect source files [1]? I know I could probably make it work if I made a package out of the previous build products, but I really want to avoid that in order to not increase the build complexity even further. Cheers Lars [0] <http://article.gmane.org/gmane.comp.lang.haskell.cafe/113016> [1] After reading the section on "the search path" (?4.7.3, <https://downloads.haskell.org/~ghc/7.6.3/docs/html/users_guide/separate-compilation.html#search-path>), that doesn't seem to be possible. From martin.drautzburg at web.de Mon Nov 24 20:41:25 2014 From: martin.drautzburg at web.de (martin) Date: Mon, 24 Nov 2014 21:41:25 +0100 Subject: [Haskell-cafe] Replacing IO with pure values In-Reply-To: <CAJUDvci1x87G7SkiesjrwHBpH3YhfCQh7858VwA1dpBTFjnhMQ@mail.gmail.com> References: <54734D49.3030308@web.de> <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> <CAEyhvmqA1OTxVLTDpCoCoLj++wzzR1_igGPQKAWOmGchLjLgsQ@mail.gmail.com> <CAJUDvci1x87G7SkiesjrwHBpH3YhfCQh7858VwA1dpBTFjnhMQ@mail.gmail.com> Message-ID: <547397F5.8080002@web.de> Thanks to all. This helped a lot. From agocorona at gmail.com Mon Nov 24 21:41:04 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Mon, 24 Nov 2014 22:41:04 +0100 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> <5472389A.8030503@artyom.me> <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> Message-ID: <CAArEJmYV5A-YGjp6XYEMKuFgzkCdD=8FDPp+ZLsKZGsvL15-ZQ@mail.gmail.com> Can?t agree more. Haskell may die slowly for industry if we don?t push it. For me this issue is clearly this is the major obstacle for creating high level languages close to each domain problem. Haskell can not success in other ways, because EDSLs is the natural form in which Haskell present a solution, in the same way that in Ruby is a customizable Web application, in DotNet a windows application in C is a library or console application. Believe it or not, there are problems out there that are more complicated that monads or profunctors. And these people have enough with their problems, they neither want nor need to understand your monads. They want solutions that speak in terms of their language, not yours. 99% of them will never convert themselves into a small haskell software house to have the three or four EDSLs that they need. that does not make economic sense. But they would buy haskell consultancy services to extend, integrate and install EDSLs. The day to day work can be done by the domain problem experts, since the EDSLs uses their respective jargon. As soon as there is something out there that do 20% of what haskell can do for creating high level EDSLs, with decent customizable and understandable error messages for people that know a little of programming but are intersted in having a rapid and flexible solution for their problem, then the days of Haskell as a promising language for industry may have passed away. 2014-11-23 21:42 GMT+01:00 Wojciech Danilo <wojciech.danilo at gmail.com>: > Richard - did you think about some way of funding Haskell development? I > think a lot of people are talking about low people-hours spend on GHC, but > nobody ever told that a good solution here will be funding of its > development. We've got so many options here - dotations, companies, vc's, > community funding (maybe even kickstarter). You know, this would help MUCH > Haskell and overall - everyone from this community. But in general - people > are not working this way, that if somebody will tell - this is a good idea, > everybody woudl do it. I'm writing exactly to you, because you are somebody > very close to GHC and we all see, you "want" to do something good. Why not > get funding for Haskell and GHC? I would love to help, really - as much as > I can. But if everyone agree, we have to do something with it, as fast as > possbile, othercase, Haskell will slowly die - taking in consideration how > much moneyu is put in Scala, Go etc. These languages are getting better > everyday - and of course, they've got another asusmptions than the best > programming language I've been suing in my life, they have got many > man-hours more spend on development than we do. > What do you think? > > All the best, > Wojciech > > Sun Nov 23 2014 at 8:42:29 PM u?ytkownik Artyom <yom at artyom.me> napisa?: > >> On 11/23/2014 09:01 PM, Alberto G. Corona wrote: >> >> It is so evident that this is THE problem of Haskell >> >> Unfortunately, it?s not evident. Note that I?m /not/ saying it?s not >> ?the? problem of Haskell; merely that >> >> * >> >> I consider myself to be somewhat intelligent >> >> * >> >> and ? without having put much thought into this question ? I don?t >> find it evident at all that the incomprehensibility of error >> messages arising when using DSLs is ?probably the biggest barrier >> for the acceptance of Haskell on Industry? >> >> Therefore, unless you?re sure for some reason that I?m an outlier and >> the majority of programmers /do/ find it evident but prefer to pretend >> they don?t (for pragmatic, evil, or other reasons), I would suggest >> writing an article attempting to persuade the community that it?s indeed >> a major problem ? or, better yet, the problem which has the biggest >> utility/complexity-of-implementation ratio. I remember that what got me >> into Haskell was simply a handful of ?mind-blowing? examples ? an easily >> readable parser in a few lines of code, the elegance of |map| versus a >> |for| loop, things like that. A post with side-by-side comparisons of >> real-world GHC error messages arising when working with various DSLs >> (parsec, attoparsec, blaze, binary, diagrams, etc.) vs. mockups of >> improved error messages, alongside with a section describing the current >> research done in this direction and outlining general ideas/concepts, >> would probably do the trick. >> >> ? >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/749ecf04/attachment.html> From agocorona at gmail.com Mon Nov 24 21:47:22 2014 From: agocorona at gmail.com (Alberto G. Corona ) Date: Mon, 24 Nov 2014 22:47:22 +0100 Subject: [Haskell-cafe] Domain specific error messages In-Reply-To: <54735EC9.1020902@gmail.com> References: <CAOfQma8n2zUbD2RiDKFnyCWqKnQcJB3UmTfBnE0yZbEciF9z1A@mail.gmail.com> <CAArEJmbv+EfYg8jHPA-wa+w26-dKGDMCHoiRpVL8TNp0wufctg@mail.gmail.com> <5472389A.8030503@artyom.me> <CABErSvBwqLDU+katguc69eQUwER3=P5rPOs-Cn3nbV+EWjh9xQ@mail.gmail.com> <CAHnFXOs1p2GzwNj3Pi_qZJemGdKH2eCP2VfM_hdq1mXBpGYTzg@mail.gmail.com> <54735EC9.1020902@gmail.com> Message-ID: <CAArEJmYzTQxF_jXx_74s4bg8r5xRmV6NVFv_X_O2qhhDSGzH3g@mail.gmail.com> That is fantastic news. Very nice to know that the project is alive and with aims to produce tangible results. As Felipe said, please ping your advances there. To add some estimated dates would be fantastic. 2014-11-24 17:37 GMT+01:00 Felipe Lessa <felipe.lessa at gmail.com>: > On 24-11-2014 06:27, Alejandro Serrano Mena wrote: > > At Utrecht University we are currently tackling this problem, in the > > form of the DOMain Specific Type Error Diagnosis (DOMSTED) Project [1]. > > So at least we have one person (me) working full-time on it, plus my > > supervisor Jurriaan Hage, which had already worked in a similar project > > for Haskell 98 which produced the Helium [2] compiler. > > We are slowly building step towards a nice way to create domain specific > > error messages, and we expect to have some nice results soon :) > > Of course, if you have any ideas on how to improve error messages, feel > > free to contact me :) > > It would be nice if you could ping relevant issues (such as [1]) stating > that you're researching on this topic. > > Cheers, > > [1] https://ghc.haskell.org/trac/ghc/ticket/7870 > > -- > Felipe. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141124/887ae7fe/attachment.html> From spopejoy at panix.com Tue Nov 25 04:41:41 2014 From: spopejoy at panix.com (Stuart Popejoy) Date: Mon, 24 Nov 2014 23:41:41 -0500 Subject: [Haskell-cafe] "Flatten" JSON objects under toListOf Message-ID: <54740885.1020300@panix.com> Hi, I'd like to transform some JSON to "flatten" objects in a list to a single dimension. Say I have: [{ "Name": "Stuart", "Dimensions": { "H": 71, "W": 170 } }, { "Name": "Sam", "Dimensions": { "H": 72, "W": 180 } }] How do I get it to just [{ "Name": "Stuart", "W": 170 } }, { "Name": "Sam", "W": 180 } }] I've tried zipWith with various toListOf constructions to pick apart and rebuild a new JSON object. Is there a better way? Thanks, Stuart From mail at joachim-breitner.de Tue Nov 25 08:52:41 2014 From: mail at joachim-breitner.de (Joachim Breitner) Date: Tue, 25 Nov 2014 09:52:41 +0100 Subject: [Haskell-cafe] GHC: Discovery of source dependencies without --make In-Reply-To: <54739500.8010503@hupel.info> References: <54739500.8010503@hupel.info> Message-ID: <1416905561.1435.3.camel@joachim-breitner.de> Hi Lars, Am Montag, den 24.11.2014, 21:28 +0100 schrieb Lars Hupel: > Is there any way to get the dependency discovery of '--make' without the > rest? Or alternatively, to get '--make' to not just respect source files > [1]? I don?t have an answer for you right now, but you might have more luck asking on the glasgow-haskell-users at haskell.org mailing list (more GHC experts, less other noise), and you might be able to motivate people to play around if you provide examples files and commands to reproduce the problem ? after all, there might be a bug in GHC, and bug reports should be reproducible. Greetings, Joachim -- Joachim ?nomeata? Breitner mail at joachim-breitner.de ? http://www.joachim-breitner.de/ Jabber: nomeata at joachim-breitner.de ? GPG-Key: 0xF0FBF51F Debian Developer: nomeata at debian.org -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: This is a digitally signed message part URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141125/904401c1/attachment.sig> From dgorin at dc.uba.ar Tue Nov 25 11:15:10 2014 From: dgorin at dc.uba.ar (=?windows-1252?Q?Daniel_Gor=EDn?=) Date: Tue, 25 Nov 2014 11:15:10 +0000 Subject: [Haskell-cafe] "Flatten" JSON objects under toListOf In-Reply-To: <54740885.1020300@panix.com> References: <54740885.1020300@panix.com> Message-ID: <35CD4909-27EA-42FD-BB8A-40C0D86C1F32@dc.uba.ar> I would just write a parser that picks the fields you want. You could have the parser return a Value but I?d rather collect them in a separate data-structure. For your example, one would have: flatten :: Value -> Either String Value flatten = fmap reencode . parseEither extract where extract = withObject "my obj" $ \o -> do dv <- o .: "Dimensions" flip (withObject "dim") dv $ \d -> liftA2 (,) (o .: "Name") (d .: "W") reencode :: (Text,Int) -> Value reencode (n,w) = object [ "Name" .= n, "W" .= w ] Now you can map the flatten function over your list of of objects, find out those that were malformed, etc. On 25 Nov 2014, at 04:41, Stuart Popejoy <spopejoy at panix.com> wrote: > Hi, > > I'd like to transform some JSON to "flatten" objects in a list to a single dimension. Say I have: > > [{ "Name": "Stuart", "Dimensions": { "H": 71, "W": 170 } }, > { "Name": "Sam", "Dimensions": { "H": 72, "W": 180 } }] > > How do I get it to just > > [{ "Name": "Stuart", "W": 170 } }, > { "Name": "Sam", "W": 180 } }] > > I've tried zipWith with various toListOf constructions to pick apart and rebuild a new JSON object. Is there a better way? > > Thanks, > Stuart > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From polux2001 at gmail.com Tue Nov 25 11:56:56 2014 From: polux2001 at gmail.com (Paul Brauner) Date: Tue, 25 Nov 2014 11:56:56 +0000 Subject: [Haskell-cafe] Replacing IO with pure values References: <54734D49.3030308@web.de> <CAEyhvmoOrD6eQuVjUYbiGjB=PMDhpGESWqnwoY+haEiStc96-g@mail.gmail.com> <CAEyhvmqA1OTxVLTDpCoCoLj++wzzR1_igGPQKAWOmGchLjLgsQ@mail.gmail.com> <CAJUDvci1x87G7SkiesjrwHBpH3YhfCQh7858VwA1dpBTFjnhMQ@mail.gmail.com> <547397F5.8080002@web.de> Message-ID: <CAJ32BF61TPEKKzLiP_Mpx1xnFoOsO2_d1o6vnxKcAzYhcMgEsw@mail.gmail.com> There's https://hackage.haskell.org/package/IOSpec which provides a pure implementation of the IO monad. Once you're done testing your code you can import Test.IOSpec.Surrogate which declares type IOSpec f a = IO a. Would be a nice use case for ML-style modules btw :) On Mon Nov 24 2014 at 9:46:29 PM martin <martin.drautzburg at web.de> wrote: > Thanks to all. This helped a lot. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141125/1081e13e/attachment.html> From dominic at steinitz.org Tue Nov 25 12:07:42 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Tue, 25 Nov 2014 12:07:42 +0000 Subject: [Haskell-cafe] suggestions about a library for numerical calculation In-Reply-To: <CADDFi2UhGV2dgB8zGMK05E8zDk_7jdJGK1GC+gin4X5EzZhqkQ@mail.gmail.com> References: <CA+AeLgQQOObFum95OcASKZaAXqQVdiBYf4wtqOhLeN4NNmaGPA@mail.gmail.com> <CADDFi2UhGV2dgB8zGMK05E8zDk_7jdJGK1GC+gin4X5EzZhqkQ@mail.gmail.com> Message-ID: <9B5984D6-84FD-4FD4-967F-BBB1E9432E13@steinitz.org> There?s at least two answers to this. 1) Most numerical methods do not have a native Haskell implementation (on Hackage) probably even RK4 so the world is your oyster 2) Most numerical methods have a highly optimised implementation that worries about overflow and underflow etc probably written in Fortran but maybe in C so why re-invent the wheel but just provide bindings to them. My answer is that I would like to have my cake and eat it and I think the new Numeric.LinearAlgebra.Static module starts to do this. I get type safety at compile time and I get speed. Frank tells me he can get pretty close to C speed using unboxed vectors. Maybe we can go even faster using unsafe operations but keeping static guarantees by exploiting the type system in the same way that HMatrix does (type level literals). Here?s what I would do if I had time. Look at Julia, pick an interesting library / application, use Vector and Repa to implement, compare speeds while using type level programming to preserve safety. I?d like Haskell to be faster and safer. Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com On 24 Nov 2014, at 12:05, Tom Nielsen <tanielsen at gmail.com> wrote: > I'd say we're lacking in the optimization and classification department. While there are libraries for this, they are mostly bindings to C libraries which makes it more difficult to get information out of the algorithm. We have implemented BFGS and Nelder-mead here: https://github.com/glutamate/probably-baysig/tree/master/src/Math/Probably but that isn't officially open sourced (and lacking L-BFGS). > > We're also a lot of image processing now, and native Haskell implementations of SIFT and Gaussian mixture model fitting would be extremely useful. > > Tom > > > > On Thu, Nov 20, 2014 at 5:44 PM, felipe zapata <tifonzafel at gmail.com> wrote: > Hi all, > I want to develop some tools on top of Vector and Repa, and I've wondered what tools could be useful that are not already on hmatrix. > > Any suggestions would be appreciated, > > Felipe Z. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141125/e067a08c/attachment.html> From jkarni at gmail.com Tue Nov 25 13:55:53 2014 From: jkarni at gmail.com (Julian Arni) Date: Tue, 25 Nov 2014 14:55:53 +0100 Subject: [Haskell-cafe] Replacing IO with pure values Message-ID: <CAPSChMMxWxkW+9yh1EwUw3FGmrRvXqm9gTwktMVB7Tim73WesA@mail.gmail.com> Besides, the aforementioned IOSpec, I would also suggest taking a look at "Purify Code Using Free Monads" [0], which gives a nice introduction to a general approach. If you're faced with library functions (i.e., ones you haven't written yourself) that do IO, it can become a little onerous to mock them all, though. In case the IO you're interested in testing is mostly stdin/stderr/stdout related, you could also look at the 'silently' package [1]. Finally, the 'knob' package [2] allows you to use in-memory file handles, so it helps if your tack ends up being passing Handles to pure functions (so that in the executable, those handles are stdin/stderr/stdout + files etc, but in the test they're just in-memory handles provided by 'knob'). 'System.Environment' has 'withArgs', which provides for the case of testing command-line args. [0] http://www.haskellforall.com/2012/07/purify-code-using-free-monads.html [1] https://hackage.haskell.org/package/silently-1.2.4.1 [2] http://hackage.haskell.org/package/knob-0.1.1/docs/Data-Knob.html -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141125/398266ec/attachment.html> From tanielsen at gmail.com Tue Nov 25 15:08:00 2014 From: tanielsen at gmail.com (Tom Nielsen) Date: Tue, 25 Nov 2014 15:08:00 +0000 Subject: [Haskell-cafe] suggestions about a library for numerical calculation In-Reply-To: <9B5984D6-84FD-4FD4-967F-BBB1E9432E13@steinitz.org> References: <CA+AeLgQQOObFum95OcASKZaAXqQVdiBYf4wtqOhLeN4NNmaGPA@mail.gmail.com> <CADDFi2UhGV2dgB8zGMK05E8zDk_7jdJGK1GC+gin4X5EzZhqkQ@mail.gmail.com> <9B5984D6-84FD-4FD4-967F-BBB1E9432E13@steinitz.org> Message-ID: <CADDFi2UEuQL+Zw39hzNVy8zZz2gZFr0qeh5nFOjBYNTvm0C6tw@mail.gmail.com> Felipe, Here is a fairly detailed paper that describes an image processing pipeline that was state-of-the-art a few years ago, before Deep Learning became the new uber-buzzword: https://hal.inria.fr/hal-00830491/PDF/journal.pdf this is probably still competitive in performance to within a few percent. We are using CUDA code from https://dms.sztaki.hu/en/project/gaussian-mixture-modeling-gmm-and-fisher-vector-toolkit Tom On Tue, Nov 25, 2014 at 12:07 PM, Dominic Steinitz <dominic at steinitz.org> wrote: > There?s at least two answers to this. 1) Most numerical methods do not > have a native Haskell implementation (on Hackage) probably even RK4 so the > world is your oyster 2) Most numerical methods have a highly optimised > implementation that worries about overflow and underflow etc probably > written in Fortran but maybe in C so why re-invent the wheel but just > provide bindings to them. > > My answer is that I would like to have my cake and eat it and I think the > new Numeric.LinearAlgebra.Static module starts to do this. I get type > safety at compile time and I get speed. Frank tells me he can get pretty > close to C speed using unboxed vectors. Maybe we can go even faster using > unsafe operations but keeping static guarantees by exploiting the type > system in the same way that HMatrix does (type level literals). > > Here?s what I would do if I had time. Look at Julia, pick an interesting > library / application, use Vector and Repa to implement, compare speeds > while using type level programming to preserve safety. I?d like Haskell to > be faster and safer. > > Dominic Steinitz > dominic at steinitz.org > http://idontgetoutmuch.wordpress.com > > On 24 Nov 2014, at 12:05, Tom Nielsen <tanielsen at gmail.com> wrote: > > I'd say we're lacking in the optimization and classification department. > While there are libraries for this, they are mostly bindings to C libraries > which makes it more difficult to get information out of the algorithm. We > have implemented BFGS and Nelder-mead here: > https://github.com/glutamate/probably-baysig/tree/master/src/Math/Probably > but that isn't officially open sourced (and lacking L-BFGS). > > We're also a lot of image processing now, and native Haskell > implementations of SIFT and Gaussian mixture model fitting would be > extremely useful. > > Tom > > > > On Thu, Nov 20, 2014 at 5:44 PM, felipe zapata <tifonzafel at gmail.com> > wrote: > >> Hi all, >> I want to develop some tools on top of Vector and Repa, and I've >> wondered what tools could be useful that are not already on hmatrix. >> >> Any suggestions would be appreciated, >> >> Felipe Z. >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141125/fa5f1984/attachment.html> From the.l.a.cat at gmail.com Wed Nov 26 19:10:44 2014 From: the.l.a.cat at gmail.com (Nikita) Date: Wed, 26 Nov 2014 23:10:44 +0400 Subject: [Haskell-cafe] Haskell Wiki engine. Message-ID: <CAHSs267zcB4nAYOX9c9bxaPjY2myy0iZxK2z5taru6k-vafKYQ@mail.gmail.com> Hello. It is apparently not possible to either register on the wiki or contact an administrator without an account, so I have to resort to writing here. What is the engine of the Haskell Wiki? Is it MediaWiki or what? -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141126/891feefe/attachment.html> From yom at artyom.me Wed Nov 26 19:14:05 2014 From: yom at artyom.me (Artyom) Date: Wed, 26 Nov 2014 22:14:05 +0300 Subject: [Haskell-cafe] Haskell Wiki engine. In-Reply-To: <CAHSs267zcB4nAYOX9c9bxaPjY2myy0iZxK2z5taru6k-vafKYQ@mail.gmail.com> References: <CAHSs267zcB4nAYOX9c9bxaPjY2myy0iZxK2z5taru6k-vafKYQ@mail.gmail.com> Message-ID: <5476267D.7010005@artyom.me> On 11/26/2014 10:10 PM, Nikita wrote: > What is the engine of the Haskell Wiki? Is it MediaWiki or what? https://www.haskell.org/haskellwiki/Special:Version In particular: MediaWiki <https://www.mediawiki.org/> 1.19.20+dfsg-0+deb7u1 PHP <http://www.php.net/> 5.4.35-0+deb7u2 (apache2handler) MySQL <http://www.mysql.com/> 5.5.5-10.0.13-MariaDB-1~trusty-log From jeffbrown.the at gmail.com Wed Nov 26 19:59:21 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Wed, 26 Nov 2014 11:59:21 -0800 Subject: [Haskell-cafe] Replacing IO with pure values In-Reply-To: <CAPSChMMxWxkW+9yh1EwUw3FGmrRvXqm9gTwktMVB7Tim73WesA@mail.gmail.com> References: <CAPSChMMxWxkW+9yh1EwUw3FGmrRvXqm9gTwktMVB7Tim73WesA@mail.gmail.com> Message-ID: <CAEc4Ma3gvhn-J8ywXskd_ms9wxczaznXQK+QR7tO59zjB4n4Jg@mail.gmail.com> It seems like it ought to be possible to manually test some IO once, record the user input, and automate future testing by using that record. Is it not? On Tue, Nov 25, 2014 at 5:55 AM, Julian Arni <jkarni at gmail.com> wrote: > Besides, the aforementioned IOSpec, I would also suggest taking a look at > "Purify Code Using Free Monads" [0], which gives a nice introduction to a > general approach. If you're faced with library functions (i.e., ones you > haven't written yourself) that do IO, it can become a little onerous to > mock them all, though. In case the IO you're interested in testing is > mostly stdin/stderr/stdout related, you could also look at the 'silently' > package [1]. Finally, the 'knob' package [2] allows you to use in-memory > file handles, so it helps if your tack ends up being passing Handles to > pure functions (so that in the executable, those handles are > stdin/stderr/stdout + files etc, but in the test they're just in-memory > handles provided by 'knob'). 'System.Environment' has 'withArgs', which > provides for the case of testing command-line args. > > [0] > http://www.haskellforall.com/2012/07/purify-code-using-free-monads.html > [1] https://hackage.haskell.org/package/silently-1.2.4.1 > [2] http://hackage.haskell.org/package/knob-0.1.1/docs/Data-Knob.html > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141126/5f1e8706/attachment.html> From wojtek at power.com.pl Wed Nov 26 21:17:16 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Wed, 26 Nov 2014 22:17:16 +0100 Subject: [Haskell-cafe] DataKinds + KindSignatures question Message-ID: <5476435C.5020404@power.com.pl> Hello, The following code: > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE KindSignatures #-} > > import Data.ByteString > > data CmdKind = GET | SET > > class Serialize (cmd :: CmdKind) where > serialize :: cmd -> ByteString Results in the following error: > wojtek at wojtek-desktop:~/src/he/snip$ ghc dk.hs > [1 of 1] Compiling Main ( dk.hs, dk.o ) > > dk.hs:9:17: > Expected a type, but ?cmd? has kind ?CmdKind? > In the type ?cmd -> ByteString? > In the class declaration for ?Serialize? Is this so by design, or should I write it in a different way, or is it just not implemented? -- Kind regards, Wojtek N. From karl at karlv.net Thu Nov 27 04:08:53 2014 From: karl at karlv.net (Karl Voelker) Date: Wed, 26 Nov 2014 20:08:53 -0800 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <5476435C.5020404@power.com.pl> References: <5476435C.5020404@power.com.pl> Message-ID: <1417061333.3385714.195923073.51A93163@webmail.messagingengine.com> On Wed, Nov 26, 2014, at 01:17 PM, Wojtek Narczy?ski wrote: > > dk.hs:9:17: > > Expected a type, but ?cmd? has kind ?CmdKind? > > In the type ?cmd -> ByteString? > > In the class declaration for ?Serialize? > The error message says that it expected a type. That might be a bit confusing. What it means by "type" is "a thing with kind *". That is the kind of types, and those types are the only things which have values. The argument to a function must be a value, so the argument to the "->" operator must be a type. Another example to consider which might make this more clear: Prelude> let { f :: Maybe -> a; f x = undefined } <interactive>:2:12: Expecting one more argument to ?Maybe? Expected a type, but ?Maybe? has kind ?* -> *? In the type signature for ?f?: f :: Maybe -> a Notice that in the type signature for f, I forgot to apply Maybe to an argument. On its own, Maybe has kind * -> *, which means that Maybe is not a type. After all, there is no such thing as a "value of type Maybe". > Is this so by design, or should I write it in a different way, or is it > just not implemented? I don't think it's clear what you are trying to do, so it is hard to say what you should write. -Karl From dominic at steinitz.org Thu Nov 27 08:22:13 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Thu, 27 Nov 2014 08:22:13 +0000 Subject: [Haskell-cafe] Why is type level (+) not commutative? Message-ID: <AEF558C6-851C-4041-AF15-47A59597B708@steinitz.org> I have a type signature (for an extended Kalman filter as it happens thought that is not relevant) > outer :: forall m n p q . > (KnownNat m, KnownNat n, KnownNat p, KnownNat q, > (1 <=? n) ~ 'True, (1 <=? m) ~ 'True, > (1 <=? p) ~ 'True, (n + q) ~ p) => > R n -> Sq n -> > L m n -> Sq m -> > (R p -> R n) -> (R n -> Sq n) -> Sq n -> > [R m] -> [R q] -> > [(R n, Sq n)] and my function compiles. If I change (n+ q) ~ p to (q + n) ~ p then I get a type error > Could not deduce (p ~ (n + q)) > from the context (KnownNat m, > KnownNat n, > KnownNat p, > KnownNat q, > (1 <=? n) ~ 'True, > (1 <=? m) ~ 'True, > (1 <=? p) ~ 'True, > (q + n) ~ p) Is expressing commutativity not possible? Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com From wojtek at power.com.pl Thu Nov 27 08:56:07 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Thu, 27 Nov 2014 09:56:07 +0100 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <1417061333.3385714.195923073.51A93163@webmail.messagingengine.com> References: <5476435C.5020404@power.com.pl> <1417061333.3385714.195923073.51A93163@webmail.messagingengine.com> Message-ID: <5476E727.4090802@power.com.pl> On 27.11.2014 05:08, Karl Voelker wrote: > The error message says that it expected a type. That might be a bit > confusing. What it means by "type" is "a thing with kind *". That is the > kind of types, and those types are the only things which have values. > The argument to a function must be a value, so the argument to the "->" > operator must be a type. But why is it expecting type of kind '*' and rejecting type of kind 'CmdKind'? Functions are limited to work on types of kind '*'? > > I don't think it's clear what you are trying to do, so it is hard to say > what you should write. I wanted to declare a class for that can only be instantiated for types of certain kind, and then create instances for all that types in a single statement. Basically, I was just trying to understand how kinds and type classes are related. Also, trying to save some typing. -- Thank you, Wojtek Narczynski From frank at fstaals.net Thu Nov 27 09:06:30 2014 From: frank at fstaals.net (Frank Staals) Date: Thu, 27 Nov 2014 10:06:30 +0100 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <5476435C.5020404@power.com.pl> ("Wojtek =?utf-8?Q?Narczy?= =?utf-8?Q?=C5=84ski=22's?= message of "Wed, 26 Nov 2014 22:17:16 +0100") References: <5476435C.5020404@power.com.pl> Message-ID: <878uix1089.fsf@Shanna.FStaals.net> Wojtek Narczy?ski <wojtek at power.com.pl> writes: > Hello, > > The following code: > >> {-# LANGUAGE DataKinds #-} >> {-# LANGUAGE KindSignatures #-} >> >> import Data.ByteString >> >> data CmdKind = GET | SET >> >> class Serialize (cmd :: CmdKind) where >> serialize :: cmd -> ByteString > > Results in the following error: > >> wojtek at wojtek-desktop:~/src/he/snip$ ghc dk.hs >> [1 of 1] Compiling Main ( dk.hs, dk.o ) >> >> dk.hs:9:17: >> Expected a type, but ?cmd? has kind ?CmdKind? >> In the type ?cmd -> ByteString? >> In the class declaration for ?Serialize? > > Is this so by design, or should I write it in a different way, or is it just > not implemented? As Karl explained, type parameters of (->) need to have kind *, whereas your argument cmd has kind CmdKind. A ``workaround'' to this is using Proxy (or any other type that has something of kind CmdKind as (phantom) type). You can then define something like: import Data.Proxy class Serialize (cmd :: CmdKind) where serialize :: Proxy cmd -> ByteString myByteString = serialize (Proxy :: Proxy GET) Depending on what you are trying to do that may be applicable. Regards, -- - Frank From wojtek at power.com.pl Thu Nov 27 10:04:48 2014 From: wojtek at power.com.pl (=?UTF-8?B?V29qdGVrIE5hcmN6ecWEc2tp?=) Date: Thu, 27 Nov 2014 11:04:48 +0100 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <878uix1089.fsf@Shanna.FStaals.net> References: <5476435C.5020404@power.com.pl> <878uix1089.fsf@Shanna.FStaals.net> Message-ID: <5476F740.7040005@power.com.pl> On 27.11.2014 10:06, Frank Staals wrote: > > As Karl explained, type parameters of (->) need to have kind *, whereas > your argument cmd has kind CmdKind. Okay, I get it now. I can't have regular functions on types of kind other than '*'. I must stop thinking of '*' as some of wildcard. > A ``workaround'' to this is using > Proxy (or any other type that has something of kind CmdKind as (phantom) > type). You can then define something like: > > import Data.Proxy > > class Serialize (cmd :: CmdKind) where > serialize :: Proxy cmd -> ByteString > > myByteString = serialize (Proxy :: Proxy GET) > > Depending on what you are trying to do that may be applicable. > > Oh, so Proxy can be understood as a type level function from 'CmdKind' to '*'? -- Kind regards, Wojtek Narczynski From ivan.miljenovic at gmail.com Thu Nov 27 10:09:24 2014 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Thu, 27 Nov 2014 21:09:24 +1100 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <5476F740.7040005@power.com.pl> References: <5476435C.5020404@power.com.pl> <878uix1089.fsf@Shanna.FStaals.net> <5476F740.7040005@power.com.pl> Message-ID: <CA+u6gbzHT-gJjiXJvjO=WfH88Mjvz1ek_Y03O+dhn=hObMWVSg@mail.gmail.com> On 27 November 2014 at 21:04, Wojtek Narczy?ski <wojtek at power.com.pl> wrote: > On 27.11.2014 10:06, Frank Staals wrote: >> >> >> As Karl explained, type parameters of (->) need to have kind *, whereas >> your argument cmd has kind CmdKind. > > > Okay, I get it now. I can't have regular functions on types of kind other > than '*'. I must stop thinking of '*' as some of wildcard. > >> A ``workaround'' to this is using >> Proxy (or any other type that has something of kind CmdKind as (phantom) >> type). You can then define something like: >> >> import Data.Proxy >> >> class Serialize (cmd :: CmdKind) where >> serialize :: Proxy cmd -> ByteString >> >> myByteString = serialize (Proxy :: Proxy GET) >> >> Depending on what you are trying to do that may be applicable. >> >> > Oh, so Proxy can be understood as a type level function from 'CmdKind' to > '*'? Not really: "Proxy CmdKind" is the safer/saner equivalent of doing "(undefined :: CmdKind)" to be able to specify a type. e.g.: show . (`asProxyTypeOf` (Proxy :: Proxy Int)) . read It just brings the type into scope, not any actual values. > > -- > Kind regards, > Wojtek Narczynski > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From roma at ro-che.info Thu Nov 27 10:26:51 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Thu, 27 Nov 2014 12:26:51 +0200 Subject: [Haskell-cafe] DataKinds + KindSignatures question In-Reply-To: <5476F740.7040005@power.com.pl> References: <5476435C.5020404@power.com.pl> <878uix1089.fsf@Shanna.FStaals.net> <5476F740.7040005@power.com.pl> Message-ID: <5476FC6B.6010007@ro-che.info> On 27/11/14 12:04, Wojtek Narczy?ski wrote: > I must stop thinking of '*' as some of wildcard. Totally. > Oh, so Proxy can be understood as a type level function from 'CmdKind' > to '*'? Sure. In fact, any type constructor can be seen as a (possibly nullary) type function: Prelude> :k Maybe Maybe :: * -> * Maybe is a type function from types (*) to types (*). Prelude Control.Monad.State> :k StateT StateT :: * -> (* -> *) -> * -> * StateT (not to be confused with StateT on the value level that has type (s -> m (a, s)) -> StateT s m a) is a type function of three arguments, two of them of kind * and one of kind (* -> *). Now let's look at Proxy: Prelude Data.Proxy> :k Proxy Proxy :: k -> * Proxy is declared as a kind-polymorphic type (see PolyKinds). Here k is actually a "wildcard" (a kind variable that can be instantiated with any kind). Thus, you can specialize Proxy to be of kind * -> *, or (* -> *) -> *, or MyKind -> *. However, since the type Proxy k has a value (also called Proxy), the return kind of the Proxy type function is necessarily *. You can't build a type function returning a non-* kind using a data or newtype declaration. You can do it, however, using type families. Roman Roman From TCamps at teksystems.com Thu Nov 27 11:01:25 2014 From: TCamps at teksystems.com (Camps, Tony) Date: Thu, 27 Nov 2014 11:01:25 +0000 Subject: [Haskell-cafe] An opportunity in Singapore Message-ID: <BF0CC331BAA07E448AD65CA6E4232015E11E544F@EUR-COLOEMBX01.allegisgroup.com> Good morning Haskellers! Hope all is well; I understand that the natural reaction to recruiters posting on these mailing lists would be spite and malice so I took some advice from a Haskell Developer I know. He said to cut the buzzword bingo, be transparent about remuneration and be honest about location. So here we go: - This is an opportunity to relocate to Singapore on a permanent basis to work for a leading Investment Bank (I think we all know who I am talking about...) - The role is working on the development & support of Cortex/ Mu(Haskell) based applications for the Process Automation and Efficiency team including a proprietary reporting tool. - The salary is set at SGD 105,000 basic with a good bonus and benefits ? more details on request. All relocation is handled by the bank. This role is perfect for someone with a passion or FP and keen to have an adventure in Asia! I hope I have been brief but to the point ? further details are available on request via return email: tcamps at teksystems.com<mailto:tcamps at teksystems.com> Look forward to hearing from you! Regards, Tony [http://www.allegisgroup.co.uk/images/tek/tek_sig_logo.gif] Tony Camps T +44 (0)207 997 1026 | M +44 (0)781 790 3478 [http://www.allegisgroup.co.uk/images/tek/tek_sig_linkedin.gif]<https://www.linkedin.com/company/teksystems> [http://www.allegisgroup.co.uk/images/tek/tek_sig_facebook.gif] <https://www.facebook.com/TEKsystemsJobs> [http://www.allegisgroup.co.uk/images/tek/tek_sig_twitter.gif] <https://twitter.com/TEKsystemsJobs> Our People Make IT Possible. Learn why.<http://www.teksystems.com> ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Trading under the TEKsystems brand. Registered in: England: Allegis Group Ltd, OTV House, East Wing, Wokingham Road, Bracknell, Berkshire, RG42 1NG, United Kingdom. No. 2876353. Belgium: Allegis Group SA 9 Rue Guimard, 1040 Brussels, Belgium. No. 0543691037. France: Aston Carter International SAS. 2e ?tage, 40-42 Rue La Bo?tie, 75008 Paris, France. Co Reg/Siren 499 449 494 RCS Paris. Germany: TEKsystems ist ein Gesch?ftsbereich der Allegis Group GmbH mit Sitz in Frankfurt am Main. Amtsgericht Frankfurt Am Main, HRB 52009, Gesch?ftsf?hrer Christopher Lee Hartman. Netherlands: Allegis Group B.V., Godebaldkwartier 365, Kantoor Janssoenborch, 3e Verdieping, 3511 DT Utrecht, Nederland. Company No. 14109133. Allegis Contracting B.V., Godebaldkwartier 365, Kantoor Janssoenborch, 3e Verdieping, 3511 DT Utrecht, Nederland. Company No. 34254913. Sweden: Aston Carter International Ltd UK Filial. Grev Turegatan 3, 114 46 Stockholm, Sweden. No. 516404-0163. This email is confidential and intended solely for the use of the individual to whom it is addressed. Any views or opinions presented are solely those of the author and do not necessarily represent those of Allegis Group, Allegis Group companies or Allegis Group brands. If you are not the intended recipient, be advised that you have received this email in error and that any use, dissemination, forwarding, printing or copying of this email is strictly prohibited. If you have received this email in error please notify postmaster at teksystems.com<mailto:postmaster at teksystems.com> ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- This electronic mail (including any attachments) may contain information that is privileged, confidential, and/or otherwise protected from disclosure to anyone other than its intended recipient(s). Any dissemination or use of this electronic mail or its contents (including any attachments) by persons other than the intended recipient(s) is strictly prohibited. If you have received this message in error, please notify us immediately by reply e-mail so that we may correct our internal records. Please then delete the original message (including any attachments) in its entirety. Thank you -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/02d736a2/attachment.html> From waldmann at imn.htwk-leipzig.de Thu Nov 27 11:58:56 2014 From: waldmann at imn.htwk-leipzig.de (Johannes Waldmann) Date: Thu, 27 Nov 2014 11:58:56 +0000 (UTC) Subject: [Haskell-cafe] --hyperlinks-in-source ? Message-ID: <loom.20141127T122743-520@post.gmane.org> I am using 'standalone-haddock --hyperlink-source' (and I cannot praise this enough) but ... is there some way to get hyperlinks *in* the source? currently, I have to jump back and forth between doc (which has all the links) and source (which I want to navigate - actually, present for others so they can browse) I understand there's a nontrivial design space but I could imagine a basic functionality like: for each identifier i (type, class, constructor, function) that appears in the source, generate the link that haddock would produce for " -- | 'i' " (3.8.7. Hyperlinked Identifiers https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810770608 ) - J.W. From gesh at gesh.uni.cx Thu Nov 27 13:01:23 2014 From: gesh at gesh.uni.cx (Gesh hseG) Date: Thu, 27 Nov 2014 15:01:23 +0200 Subject: [Haskell-cafe] Increasing Haskell modularity In-Reply-To: <abd3b039-640e-4607-8683-829ea6f81c7a@googlegroups.com> References: <20141002142106.D09F2C3827@www1.g3.pair.com> <CAML5wvsVFWG5Qm+5U_W2LQy--CcHR4jO8QtYjWvXEnjcqSzaKA@mail.gmail.com> <abd3b039-640e-4607-8683-829ea6f81c7a@googlegroups.com> Message-ID: <CACS5XqPzFB+W8dLxJumeVM8yEvL9AJ0oj8LJ6Byf6PoA1AvSBg@mail.gmail.com> Thanks for the feedback everyone. It appears that I gave a rash and ill-considered solution to a thorny problem, and that what may appear to me to be unnecessary restrictions are, in fact, the very things that allow important parts of the Haskell ecosystem to work. Indeed, it turns out that where necessary, the reflection-extras[1] package gives us enough tools to be able to write local instances easily, so even if we decide in the long run not to support local instances, we have that. Admittedly, the sources that were given in this discussion were publicly available, and if I'd properly searched for prior discussions, I would probably have found them. I apologize for the lack of due diligence. Therefore, I'd like to refocus this discussion on another question I raised. Is there any usecase for open type families that isn't subsumed by closed type families and associated data types? In addition, aren't signatures referring to open type families inherently unsafe due to the lack of control over the instances? Thanks for the thought-provoking discussion, Gesh [1] - https://hackage.haskell.org/package/reflection-extras From corentin.dupont at gmail.com Thu Nov 27 14:03:50 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Thu, 27 Nov 2014 15:03:50 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <loom.20141127T122743-520@post.gmane.org> References: <loom.20141127T122743-520@post.gmane.org> Message-ID: <CAEyhvmoGsCEuGUzyZZcE1KKpQzwHG11oFhwH-AaVzSJjS_VR2w@mail.gmail.com> Hi Johannes, I asked this some time ago: https://www.haskell.org/pipermail/haskell-cafe/2013-June/108607.html There is something in the HaRe refactoring tool (seems to be extracted from Programatica project): https://github.com/RefactoringTools/HaRe/tree/master/tools/hs2html However I don't think it's readily usable at this stage (seems to be quite outdated). I also have this need for Nomyx: https://github.com/cdupont/Nomyx/issues/5 I think it would be very useful and used if this was existing and usable :) We could join forces to recreate it? Best, Corentin On Thu, Nov 27, 2014 at 12:58 PM, Johannes Waldmann < waldmann at imn.htwk-leipzig.de> wrote: > I am using 'standalone-haddock --hyperlink-source' > (and I cannot praise this enough) but ... > > is there some way to get hyperlinks *in* the source? > > currently, I have to jump back and forth > between doc (which has all the links) and source (which I want to navigate > - > actually, present for others so they can browse) > > I understand there's a nontrivial design space > but I could imagine a basic functionality like: > > for each identifier i (type, class, constructor, function) > that appears in the source, > generate the link that haddock would produce for " -- | 'i' " > > (3.8.7. Hyperlinked Identifiers > https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810770608 ) > > - J.W. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/8ce99220/attachment.html> From hesselink at gmail.com Thu Nov 27 15:18:27 2014 From: hesselink at gmail.com (Erik Hesselink) Date: Thu, 27 Nov 2014 16:18:27 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <loom.20141127T122743-520@post.gmane.org> References: <loom.20141127T122743-520@post.gmane.org> Message-ID: <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> I've dreamed about this before, ever since I encountered it in Agda's standard library [1]. Sounds like a substantial amount of work though... Erik [1] http://www.cse.chalmers.se/~nad/listings/lib-0.7/README.html On Thu, Nov 27, 2014 at 12:58 PM, Johannes Waldmann <waldmann at imn.htwk-leipzig.de> wrote: > I am using 'standalone-haddock --hyperlink-source' > (and I cannot praise this enough) but ... > > is there some way to get hyperlinks *in* the source? > > currently, I have to jump back and forth > between doc (which has all the links) and source (which I want to navigate - > actually, present for others so they can browse) > > I understand there's a nontrivial design space > but I could imagine a basic functionality like: > > for each identifier i (type, class, constructor, function) > that appears in the source, > generate the link that haddock would produce for " -- | 'i' " > > (3.8.7. Hyperlinked Identifiers > https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810770608 ) > > - J.W. > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From corentin.dupont at gmail.com Thu Nov 27 15:25:38 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Thu, 27 Nov 2014 16:25:38 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> Message-ID: <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> Wow, this is fantastic. And I love the colors. On Thu, Nov 27, 2014 at 4:18 PM, Erik Hesselink <hesselink at gmail.com> wrote: > I've dreamed about this before, ever since I encountered it in Agda's > standard library [1]. Sounds like a substantial amount of work > though... > > Erik > > [1] http://www.cse.chalmers.se/~nad/listings/lib-0.7/README.html > > On Thu, Nov 27, 2014 at 12:58 PM, Johannes Waldmann > <waldmann at imn.htwk-leipzig.de> wrote: > > I am using 'standalone-haddock --hyperlink-source' > > (and I cannot praise this enough) but ... > > > > is there some way to get hyperlinks *in* the source? > > > > currently, I have to jump back and forth > > between doc (which has all the links) and source (which I want to > navigate - > > actually, present for others so they can browse) > > > > I understand there's a nontrivial design space > > but I could imagine a basic functionality like: > > > > for each identifier i (type, class, constructor, function) > > that appears in the source, > > generate the link that haddock would produce for " -- | 'i' " > > > > (3.8.7. Hyperlinked Identifiers > > https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810770608 > ) > > > > - J.W. > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/90c4d3ab/attachment.html> From corentin.dupont at gmail.com Thu Nov 27 15:28:39 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Thu, 27 Nov 2014 16:28:39 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> Message-ID: <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> I see two possible implementations: - a standalone tools. The links produced link to another place in the source code HTML. - integrated with haddock. The links in the source code points back to the haddock. Which on is better? On Thu, Nov 27, 2014 at 4:25 PM, Corentin Dupont <corentin.dupont at gmail.com> wrote: > Wow, this is fantastic. And I love the colors. > > On Thu, Nov 27, 2014 at 4:18 PM, Erik Hesselink <hesselink at gmail.com> > wrote: > >> I've dreamed about this before, ever since I encountered it in Agda's >> standard library [1]. Sounds like a substantial amount of work >> though... >> >> Erik >> >> [1] http://www.cse.chalmers.se/~nad/listings/lib-0.7/README.html >> >> On Thu, Nov 27, 2014 at 12:58 PM, Johannes Waldmann >> <waldmann at imn.htwk-leipzig.de> wrote: >> > I am using 'standalone-haddock --hyperlink-source' >> > (and I cannot praise this enough) but ... >> > >> > is there some way to get hyperlinks *in* the source? >> > >> > currently, I have to jump back and forth >> > between doc (which has all the links) and source (which I want to >> navigate - >> > actually, present for others so they can browse) >> > >> > I understand there's a nontrivial design space >> > but I could imagine a basic functionality like: >> > >> > for each identifier i (type, class, constructor, function) >> > that appears in the source, >> > generate the link that haddock would produce for " -- | 'i' " >> > >> > (3.8.7. Hyperlinked Identifiers >> > >> https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810770608 >> ) >> > >> > - J.W. >> > >> > >> > _______________________________________________ >> > Haskell-Cafe mailing list >> > Haskell-Cafe at haskell.org >> > http://www.haskell.org/mailman/listinfo/haskell-cafe >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/49c4c2f7/attachment.html> From the.dead.shall.rise at gmail.com Thu Nov 27 15:32:26 2014 From: the.dead.shall.rise at gmail.com (Mikhail Glushenkov) Date: Thu, 27 Nov 2014 16:32:26 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> Message-ID: <CA+tcxkAcf7jBsnkr01jucbVaF3wawh1zckghpFigJDmfLRhfrw@mail.gmail.com> Hi, On 27 November 2014 at 16:28, Corentin Dupont <corentin.dupont at gmail.com> wrote: > - integrated with haddock. The links in the source code points back to the > haddock. IIUC, the proper place for this is hscolour, not haddock. From waldmann at imn.htwk-leipzig.de Thu Nov 27 15:57:58 2014 From: waldmann at imn.htwk-leipzig.de (Johannes Waldmann) Date: Thu, 27 Nov 2014 15:57:58 +0000 (UTC) Subject: [Haskell-cafe] --hyperlinks-in-source ? References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> Message-ID: <loom.20141127T165657-29@post.gmane.org> Erik Hesselink <hesselink <at> gmail.com> writes: > I've dreamed about this before, ever since I encountered it in Agda's > standard library [1]. Also, the Coq library documentation has it (a bit earlier, I think) https://coq.inria.fr/distrib/current/stdlib/ From allbery.b at gmail.com Thu Nov 27 16:00:55 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 27 Nov 2014 11:00:55 -0500 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CA+tcxkAcf7jBsnkr01jucbVaF3wawh1zckghpFigJDmfLRhfrw@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> <CA+tcxkAcf7jBsnkr01jucbVaF3wawh1zckghpFigJDmfLRhfrw@mail.gmail.com> Message-ID: <CAKFCL4VC_a0b-WJ+6V3mHLW5yz+hWg-+SNY3BkbyOnkb98T2+g@mail.gmail.com> On Thu, Nov 27, 2014 at 10:32 AM, Mikhail Glushenkov < the.dead.shall.rise at gmail.com> wrote: > Hi, > > On 27 November 2014 at 16:28, Corentin Dupont <corentin.dupont at gmail.com> > wrote: > > - integrated with haddock. The links in the source code points back to > the > > haddock. > > IIUC, the proper place for this is hscolour, not haddock. Indeed --- but it will need to be made much smarter, in particular it must be able to accept from cabal a list of versioned packages to resolve symbols from. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/2a72b92b/attachment.html> From palotai.robin at gmail.com Thu Nov 27 16:08:55 2014 From: palotai.robin at gmail.com (Robin Palotai) Date: Thu, 27 Nov 2014 17:08:55 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CAKFCL4VC_a0b-WJ+6V3mHLW5yz+hWg-+SNY3BkbyOnkb98T2+g@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> <CA+tcxkAcf7jBsnkr01jucbVaF3wawh1zckghpFigJDmfLRhfrw@mail.gmail.com> <CAKFCL4VC_a0b-WJ+6V3mHLW5yz+hWg-+SNY3BkbyOnkb98T2+g@mail.gmail.com> Message-ID: <CANiLjA2h+TMgyPTirLTdf3W+injCKXYiOsy=rdzfBzhBjW5hxw@mail.gmail.com> Shameless plug: there's still a lot to go, but see for example demo at http://robinp.github.io/nemnem/ (gh at https://github.com/robinp/nemnem). Robin 2014-11-27 17:00 GMT+01:00 Brandon Allbery <allbery.b at gmail.com>: > On Thu, Nov 27, 2014 at 10:32 AM, Mikhail Glushenkov < > the.dead.shall.rise at gmail.com> wrote: > >> Hi, >> >> On 27 November 2014 at 16:28, Corentin Dupont <corentin.dupont at gmail.com> >> wrote: >> > - integrated with haddock. The links in the source code points back to >> the >> > haddock. >> >> IIUC, the proper place for this is hscolour, not haddock. > > > Indeed --- but it will need to be made much smarter, in particular it must > be able to accept from cabal a list of versioned packages to resolve > symbols from. > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/7180ef7f/attachment.html> From corentin.dupont at gmail.com Thu Nov 27 16:26:46 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Thu, 27 Nov 2014 17:26:46 +0100 Subject: [Haskell-cafe] --hyperlinks-in-source ? In-Reply-To: <CANiLjA2h+TMgyPTirLTdf3W+injCKXYiOsy=rdzfBzhBjW5hxw@mail.gmail.com> References: <loom.20141127T122743-520@post.gmane.org> <CAPeieQFVDOSNqcK2Oi12mD4urx6J4MSr5jEW_VjRs7j2dUb8yw@mail.gmail.com> <CAEyhvmrtdh+OmmbXofHXshz4hqSgFypHqBOXTBUx96hNsiGgpQ@mail.gmail.com> <CAEyhvmrPCvLPPri4G+Hc2UfpRcmqM21WSJeGXFM2LySSg6kobA@mail.gmail.com> <CA+tcxkAcf7jBsnkr01jucbVaF3wawh1zckghpFigJDmfLRhfrw@mail.gmail.com> <CAKFCL4VC_a0b-WJ+6V3mHLW5yz+hWg-+SNY3BkbyOnkb98T2+g@mail.gmail.com> <CANiLjA2h+TMgyPTirLTdf3W+injCKXYiOsy=rdzfBzhBjW5hxw@mail.gmail.com> Message-ID: <CAEyhvmrP5N94xAtcW4g0-AF=wmZix0rKUnb-p7TLARb0ir7oMw@mail.gmail.com> Great! I think that's what we need!! On Thu, Nov 27, 2014 at 5:08 PM, Robin Palotai <palotai.robin at gmail.com> wrote: > Shameless plug: there's still a lot to go, but see for example demo at > http://robinp.github.io/nemnem/ (gh at https://github.com/robinp/nemnem). > Robin > > 2014-11-27 17:00 GMT+01:00 Brandon Allbery <allbery.b at gmail.com>: > >> On Thu, Nov 27, 2014 at 10:32 AM, Mikhail Glushenkov < >> the.dead.shall.rise at gmail.com> wrote: >> >>> Hi, >>> >>> On 27 November 2014 at 16:28, Corentin Dupont <corentin.dupont at gmail.com> >>> wrote: >>> > - integrated with haddock. The links in the source code points back to >>> the >>> > haddock. >>> >>> IIUC, the proper place for this is hscolour, not haddock. >> >> >> Indeed --- but it will need to be made much smarter, in particular it >> must be able to accept from cabal a list of versioned packages to resolve >> symbols from. >> >> -- >> brandon s allbery kf8nh sine nomine >> associates >> allbery.b at gmail.com >> ballbery at sinenomine.net >> unix, openafs, kerberos, infrastructure, xmonad >> http://sinenomine.net >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://www.haskell.org/mailman/listinfo/haskell-cafe >> >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141127/5317d83f/attachment.html> From vogt.adam at gmail.com Thu Nov 27 17:22:45 2014 From: vogt.adam at gmail.com (adam vogt) Date: Thu, 27 Nov 2014 12:22:45 -0500 Subject: [Haskell-cafe] Why is type level (+) not commutative? In-Reply-To: <AEF558C6-851C-4041-AF15-47A59597B708@steinitz.org> References: <AEF558C6-851C-4041-AF15-47A59597B708@steinitz.org> Message-ID: <CAHfjoW=yOebx66H3OV=odNbfsS5cW6W1FBP0B=J9qCJUaURt+g@mail.gmail.com> Hi Dominic, On Thu, Nov 27, 2014 at 3:22 AM, Dominic Steinitz <dominic at steinitz.org> wrote: > Is expressing commutativity not possible? I think the best we can do is: type PlusEqv x y xy = ( (x + y) ~ xy, (y + x) ~ xy ) And then use "(n `PlusEqv` q) p" instead of "(n + q) ~ p" Regards, Adam From oleg at okmij.org Fri Nov 28 07:50:04 2014 From: oleg at okmij.org (oleg at okmij.org) Date: Fri, 28 Nov 2014 02:50:04 -0500 (EST) Subject: [Haskell-cafe] Generating valid html In-Reply-To: <54735C6A.9010303@power.com.pl> Message-ID: <20141128075004.782A6C3842@www1.g3.pair.com> > > Somewhat related is the HSXML library for generating valid XML and > > HTML. ... > > http://okmij.org/ftp/Scheme/xml.html#typed-SXML > > Very nice syntax, but I have yet to figure out how it works. BTW the > error messages are "funny", as being discussed right now in another thread. Well, HSXML looks just as SXML, only typed. Therefore, many papers and examples that are written about SXML largely apply. I should also point out the example sample1c.hs in the HSXML distribution: test_haskell = (document (head (title "Haskell" longdash "HaskellWiki") (meta_tag (description "All about the language" br "Haskell"))) (body (h1 "Haskell") (div (attr (title "titleline")) (p (a (attr (href (FileURL "/haskellwiki/Image:Haskelllogo.jpg"))) "Haskell" br "A <purely functional> language") br ) (p "Haskell is a general purpose," (em (strong "purely") "functional") "programming language")))) There are a few comments in that file explaining a few difficult parts. > BTW the > error messages are "funny", as being discussed right now in another thread. If we change the document to read ... (p (a (attr (href (FileURL "/haskellwiki/Image:Haskelllogo.jpg"))) "Haskell" (p "A <purely functional> language")) br ) ... we do get a relevant error message No instance for (Build (DC CT_inline d0) (DC CT_block d0) (DC CT_inline d0)) arising from a use of `p' In the third argument of `a', namely `(p "A <purely functional> language")' that says that we are requiring (p ...) to produce CT_inline content (see the flag in the last argument), but p can only produce the block content. Alas, that relevant error message is buried among many irrelevant messages about ambiguous type variables. Things used to be better. The ambiguity check has brought lots and lots of trouble. I could only wish such a feature with many notable consequences were discussed more thoroughly... From anton.kholomiov at gmail.com Fri Nov 28 08:47:48 2014 From: anton.kholomiov at gmail.com (Anton Kholomiov) Date: Fri, 28 Nov 2014 12:47:48 +0400 Subject: [Haskell-cafe] Music made with Haskell Message-ID: <CADDxdqMtpxcBs7L9f_rGkRz159SOT2m_M9DhiqR3vqBLCH2PtQ@mail.gmail.com> I wrote two tracks completely with Haskell. You can listen to them on the soundcloud: https://soundcloud.com/anton-kho/celtic https://soundcloud.com/anton-kho/invisible-ocean The music is based on samples but a single track uses no more than 6 samples. The code is under 100 lines of code. I'm using my libs csound-sampler and csound-expression. You can check out the source code at: http://ge.tt/3MjwF852/v/0 Please turn off the AdBlock for this page to download the code. Happy haskelling! Anton -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141128/e7043963/attachment.html> From dominic at steinitz.org Fri Nov 28 09:19:20 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Fri, 28 Nov 2014 09:19:20 +0000 Subject: [Haskell-cafe] Why is type level (+) not commutative? In-Reply-To: <CAHfjoW=yOebx66H3OV=odNbfsS5cW6W1FBP0B=J9qCJUaURt+g@mail.gmail.com> References: <AEF558C6-851C-4041-AF15-47A59597B708@steinitz.org> <CAHfjoW=yOebx66H3OV=odNbfsS5cW6W1FBP0B=J9qCJUaURt+g@mail.gmail.com> Message-ID: <95C32E5C-5A5E-41F4-87E4-57BD55BCBCBE@steinitz.org> Thanks for this and I apologise for not being clear. I really wanted to know why the type checker couldn?t figure this out for itself. It seems one has to write e.g. (which is really equivalent to your synonym) > (n+ q) ~ p, (q + n) ~ p in the type signature if one wants commutativity. Another thing I noticed was > *Main> :t outer muPrior sigmaPrior bigH bigSigmaY > outer muPrior sigmaPrior bigH bigSigmaY > :: (KnownNat (2 + q), KnownNat q, (1 <=? (2 + q)) ~ 'True) => > (R (2 + q) -> R 2) > -> (R 2 -> Sq 2) -> Sq 2 -> [R 1] -> [R q] -> [(R 2, Sq 2)] So the type checker seems unable to discharge the constraint KnownNat q, (1 <=? (2 + q)) ~ ?True) even though that *must* be true. Also if q is a KnowNat then surely q + 2 must be a KnownNat so that constraint can also be discharged. Anyway my (extended Kalman) filter is working now and the type system made sure I didn?t make some of the mistakes that one can make in other languages. Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com On 27 Nov 2014, at 17:22, adam vogt <vogt.adam at gmail.com> wrote: > Hi Dominic, > > On Thu, Nov 27, 2014 at 3:22 AM, Dominic Steinitz <dominic at steinitz.org> wrote: >> Is expressing commutativity not possible? > > I think the best we can do is: > > type PlusEqv x y xy = ( (x + y) ~ xy, (y + x) ~ xy ) > > And then use "(n `PlusEqv` q) p" instead of "(n + q) ~ p" > > Regards, > Adam From suhailshergill at gmail.com Fri Nov 28 09:52:06 2014 From: suhailshergill at gmail.com (Suhail Shergill) Date: Fri, 28 Nov 2014 09:52:06 +0000 Subject: [Haskell-cafe] extensible effects and open unions In-Reply-To: <20130823080608.45461.qmail@www1.g3.pair.com> (oleg@okmij.org's message of "23 Aug 2013 08:06:08 -0000") References: <CAJEmqMj8Y7KoNVPS7x6zvvtkAmYheax9oigTPLLHDchfHde_pA@mail.gmail.com> <20130823080608.45461.qmail@www1.g3.pair.com> Message-ID: <87h9xjzm7t.fsf_-_@chaos.shergill.su> having recently taken over as maintainer for the extensible-effects library, i'm looking to address some of the current implementation concerns. specifically: 1] the use/need for Typeable in Data.OpenUnion oleg at okmij.org writes: > I must stress that OpenUnion1.hs described (briefly) in the paper is only one > implementation of open unions, out of many possible. For example, I have two > more implementations. A year-old version of the code implemented open unions > *WITHOUT* overlapping instances or Typeable. > http://okmij.org/ftp/Haskell/extensible/TList.hs how does the TList.hs implementation compare with, say, OpenUnion2.hs? neither require OverlappingInstances, and the TList implementation also does away with the Typeable constraint. are there reasons why it might not make sense to use TList.hs as the only/default implementation of Data.OpenUnion? 2] scope for impredicative/first-class polymorphism > By polymorphic effects you must mean first-class polymorphism (because the > already implemented Reader effect is polymorphic in the environment). First of > all, there are workarounds. what are the "workarounds" in question? > Second, I'm not sure what would be a good example of polymorphic effect (aside > from ST-monad-like). the paper mentioned "explicitly marking state, and providing an allocation system using monadic regions". is this related to <http://okmij.org/ftp/Haskell/regions.html#light-weight> and if so, what work needs to be done to apply those ideas to extensible-effects? -- Suhail From Andrew.Butterfield at scss.tcd.ie Fri Nov 28 11:44:16 2014 From: Andrew.Butterfield at scss.tcd.ie (Andrew Butterfield) Date: Fri, 28 Nov 2014 11:44:16 +0000 Subject: [Haskell-cafe] multiple declarations error in Haskell - should it be relaxed? Message-ID: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> Condsider the following Haskell program (fragment): f 0 = ?zero? g 0 = ?NULL? f n = ?non-zero? g n = ?PRESENT? This will result in two ?Multiple Declaration? errors. There is a good motivation for this - disallowing such an interleaving of declarations makes it easy for the compiler to capture a common typo, namely errors of the following form - here an attempt to define a single function called myFun. myFun 0 = ?zero? myfun 1 = ?one? myFun n = ?too big!? However I have use-cases where it would be nice to interleave as per the first example above - with markedly different function names. It invokes a large case analysis, where I have other auxiliary functions associated with each case, but which I?d like to (1) have at the top-level for testability (2) keep textually local to the case with which they are associated. I don?t think there is a language extension to disable the multiple declaration check - but would such a feature we possible. I?d see it as one which still performs the check, but issues a warning rather than an error - particularly if it notices that the interleaved names are very similar. Is this a reasonable suggestion, or are there other reasons for not doing this that I?ve missed? Maybe there is a better way to satisfy (1) and (2) above? Regards, Andrew -------------------------------------------------------------------- Andrew Butterfield Tel: +353-1-896-2517 Fax: +353-1-677-2204 Lero at TCD, Head of Foundations & Methods Research Group School of Computer Science and Statistics, Room G.39, O'Reilly Institute, Trinity College, University of Dublin http://www.scss.tcd.ie/Andrew.Butterfield/ -------------------------------------------------------------------- From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Nov 28 11:53:35 2014 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 28 Nov 2014 11:53:35 +0000 Subject: [Haskell-cafe] multiple declarations error in Haskell - should it be relaxed? In-Reply-To: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> References: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> Message-ID: <20141128115335.GO30503@weber> On Fri, Nov 28, 2014 at 11:44:16AM +0000, Andrew Butterfield wrote: > Condsider the following Haskell program (fragment): > > f 0 = ?zero? > g 0 = ?NULL? > f n = ?non-zero? > g n = ?PRESENT? > > This will result in two ?Multiple Declaration? errors. Here's a somewhat silly answer, but it may be of help. data T = F | G fun :: T -> Int -> String fun F 0 = "zero" fun G 0 = "NULL" fun F n = "non-zero" fun G n = "PRESENT" From jeffbrown.the at gmail.com Fri Nov 28 21:09:01 2014 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 28 Nov 2014 13:09:01 -0800 Subject: [Haskell-cafe] multiple declarations error in Haskell - should it be relaxed? In-Reply-To: <20141128115335.GO30503@weber> References: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> <20141128115335.GO30503@weber> Message-ID: <CAEc4Ma0A6SSJeVN8d6Z5gpMN3o7JLz35sV_7AGmzZ_=22-RRoQ@mail.gmail.com> The problem seems to boil down to the fact that (at least in every IDE I am aware of) the order in which the compiler reads your code is the same as the order in which the code is displayed to you as you write it. A general solution would be to extend the IDE to allow hyperlinks, ignored by the compiler, from one part of the code to another. It is something one could write in Emacs Lisp, to work across multiple languages. On Fri, Nov 28, 2014 at 3:53 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Fri, Nov 28, 2014 at 11:44:16AM +0000, Andrew Butterfield wrote: > > Condsider the following Haskell program (fragment): > > > > f 0 = ?zero? > > g 0 = ?NULL? > > f n = ?non-zero? > > g n = ?PRESENT? > > > > This will result in two ?Multiple Declaration? errors. > > Here's a somewhat silly answer, but it may be of help. > > data T = F | G > > fun :: T -> Int -> String > fun F 0 = "zero" > fun G 0 = "NULL" > fun F n = "non-zero" > fun G n = "PRESENT" > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141128/92455187/attachment.html> From dpiponi at gmail.com Fri Nov 28 22:11:18 2014 From: dpiponi at gmail.com (Dan Piponi) Date: Fri, 28 Nov 2014 14:11:18 -0800 Subject: [Haskell-cafe] Using ghc-mod with FFI Message-ID: <CAGL6AKJ1deWhBCR91K8C=tFZ6nJh==eC4BV_59sGXzdBh9CmqA@mail.gmail.com> In my code I have this line: foreign import ccall "set_num_states" setNumStates :: Int -> IO () I can build my project using cabal and have an appropriate "c-sources:" line. But when I use ghc-mod check (eg. from " ghc-mod-5.2.0.0", and launched from Syntastic) it complains: "ghc-mod: ByteCodeLink: can't find label During interactive linking, GHCi couldn't find the following symbol: set_num_states" How should I be checking my code? -- Dan -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141128/8ff10514/attachment.html> From yvifan at gmail.com Sat Nov 29 09:09:16 2014 From: yvifan at gmail.com (Yifan Yu) Date: Sat, 29 Nov 2014 11:09:16 +0200 Subject: [Haskell-cafe] Hosting a static site with Yesod Message-ID: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> Hi all, I'm experimenting with Yesod and I've created a simple scaffolding site with yesod. I've downloaded a bootstrap template site and wish to simply host this site with yesod. The template site has an index.html and a bunch of css and js files. This seemly simple task has baffled me. By my understanding, the site should be placed under the 'static' directory, I tried to use sendFile to send the index.html file in getHomeR, but only the content of the that file is displayed, without the css and js. Should I do this with a Subsite? Thank you -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/9d958aa9/attachment.html> From fa-ml at ariis.it Sat Nov 29 13:09:31 2014 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 29 Nov 2014 14:09:31 +0100 Subject: [Haskell-cafe] [haskell art] Music made with Haskell In-Reply-To: <CADDxdqMtpxcBs7L9f_rGkRz159SOT2m_M9DhiqR3vqBLCH2PtQ@mail.gmail.com> References: <CADDxdqMtpxcBs7L9f_rGkRz159SOT2m_M9DhiqR3vqBLCH2PtQ@mail.gmail.com> Message-ID: <20141129130931.GA3953@x60s.casa> On Fri, Nov 28, 2014 at 12:47:48PM +0400, Anton Kholomiov wrote: > I wrote two tracks completely with Haskell. > You can listen to them on the soundcloud: I downloaded the zip'd source, but I cannot listen to your track on soundcloud (it requires Flash, and Linux doesn't play well with Flash). Is there any other place I can download them from? From yom at artyom.me Sat Nov 29 13:18:03 2014 From: yom at artyom.me (Artyom) Date: Sat, 29 Nov 2014 16:18:03 +0300 Subject: [Haskell-cafe] [haskell art] Music made with Haskell In-Reply-To: <20141129130931.GA3953@x60s.casa> References: <CADDxdqMtpxcBs7L9f_rGkRz159SOT2m_M9DhiqR3vqBLCH2PtQ@mail.gmail.com> <20141129130931.GA3953@x60s.casa> Message-ID: <5479C78B.9000702@artyom.me> On 11/29/2014 04:09 PM, Francesco Ariis wrote: > On Fri, Nov 28, 2014 at 12:47:48PM +0400, Anton Kholomiov wrote: >> I wrote two tracks completely with Haskell. >> You can listen to them on the soundcloud: > I downloaded the zip'd source, but I cannot listen to your track > on soundcloud (it requires Flash, and Linux doesn't play well > with Flash). > Is there any other place I can download them from? Use youtube-dl <http://rg3.github.io/youtube-dl/>. From james at mansionfamily.plus.com Sat Nov 29 13:52:48 2014 From: james at mansionfamily.plus.com (james) Date: Sat, 29 Nov 2014 13:52:48 +0000 Subject: [Haskell-cafe] What's up on Win 8.1 64 bit, Haskell Platform? Message-ID: <5479CFB0.3000006@mansionfamily.plus.com> This is a transcript of the very first session I have after installing Haskell Platform 7.8.3, 64 bit. Why is cabal-install continuing to be confused about the version installed/available? How can I tell cabal to STFU about it? C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal update Downloading the latest package list from hackage.haskell.org Note: there is a new version of cabal-install available. To upgrade, run: cabal install cabal-install C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal install cabal-install Resolving dependencies... Downloading Cabal-1.20.0.2... Configuring Cabal-1.20.0.2... Building Cabal-1.20.0.2... Installed Cabal-1.20.0.2 Downloading cabal-install-1.20.0.3... Configuring cabal-install-1.20.0.3... Building cabal-install-1.20.0.3... Installed cabal-install-1.20.0.3 C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal update Downloading the latest package list from hackage.haskell.org Note: there is a new version of cabal-install available. To upgrade, run: cabal install cabal-install C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal install cabal-install Resolving dependencies... Configuring cabal-install-1.20.0.3... Building cabal-install-1.20.0.3... Installed cabal-install-1.20.0.3 C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal update Downloading the latest package list from hackage.haskell.org Note: there is a new version of cabal-install available. To upgrade, run: cabal install cabal-install C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal install cabal-install Resolving dependencies... Configuring cabal-install-1.20.0.3... Building cabal-install-1.20.0.3... Installed cabal-install-1.20.0.3 C:\Program Files (x86)\Microsoft Visual Studio 11.0>cabal update Downloading the latest package list from hackage.haskell.org Note: there is a new version of cabal-install available. To upgrade, run: cabal install cabal-install C:\Program Files (x86)\Microsoft Visual Studio 11.0> From allbery.b at gmail.com Sat Nov 29 13:55:19 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Sat, 29 Nov 2014 08:55:19 -0500 Subject: [Haskell-cafe] What's up on Win 8.1 64 bit, Haskell Platform? In-Reply-To: <5479CFB0.3000006@mansionfamily.plus.com> References: <5479CFB0.3000006@mansionfamily.plus.com> Message-ID: <CAKFCL4Xf9vjkJd5WPE+-yn6V5xDxCXeZ1P_OXxasd+nvEVi=4A@mail.gmail.com> On Sat, Nov 29, 2014 at 8:52 AM, james <james at mansionfamily.plus.com> wrote: > Why is cabal-install continuing to be confused about the version > installed/available? Because you are running the old one repeatedly, because your %PATH% does not include the location where cabal installs all programs including the updated version of itself. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/e797dd05/attachment.html> From mantkiew at gsd.uwaterloo.ca Sat Nov 29 14:09:40 2014 From: mantkiew at gsd.uwaterloo.ca (mantkiew at gsd.uwaterloo.ca) Date: Sat, 29 Nov 2014 09:09:40 -0500 Subject: [Haskell-cafe] What's up on Win 8.1 64 bit, Haskell Platform? In-Reply-To: <CAKFCL4Xf9vjkJd5WPE+-yn6V5xDxCXeZ1P_OXxasd+nvEVi=4A@mail.gmail.com> References: <5479CFB0.3000006@mansionfamily.plus.com> <CAKFCL4Xf9vjkJd5WPE+-yn6V5xDxCXeZ1P_OXxasd+nvEVi=4A@mail.gmail.com> Message-ID: <20141129140940.49885326.97647.1746@gsd.uwaterloo.ca> An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/8a9d21b7/attachment.html> From creichert07 at gmail.com Sat Nov 29 15:43:39 2014 From: creichert07 at gmail.com (Christopher Reichert) Date: Sat, 29 Nov 2014 09:43:39 -0600 Subject: [Haskell-cafe] Hosting a static site with Yesod In-Reply-To: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> (Yifan Yu's message of "Sat, 29 Nov 2014 11:09:16 +0200") References: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> Message-ID: <5479e9ab.d7cfca0a.47be.fffffade@mx.google.com> On Sat, Nov 29 2014, Yifan Yu <yvifan at gmail.com> wrote: > Hi all, > > I'm experimenting with Yesod and I've created a simple scaffolding site > with yesod. I've downloaded a bootstrap template site and wish to simply > host this site with yesod. The template site has an index.html and a bunch > of css and js files. This seemly simple task has baffled me. By my > understanding, the site should be placed under the 'static' directory, I > tried to use sendFile to send the index.html file in getHomeR, but only the > content of the that file is displayed, without the css and js. Should I do > this with a Subsite? > You might want to try the question on the Yesod mailing lists if you don't find your answer here. A simple solution would be to just port the index.html to hamlet and put that directly in the ./templates/homepage.hamlet file. The homepage.hamlet file is complimented by a homepage.julius and homepage.lucius file which takes a flavor of javascript and css, respectively. In Yesod, the combination of these files is known as a widget. You can move your javascript and css into those widget files directly or you can put them in your static dir (but your html is served from homepage.hamlet by default in the scaffold). The static directory is already a subsite for static resources (see the config/routes file). Also see the section "widgetFile" in this Yesod Book chapter: http://www.yesodweb.com/book/scaffolding-and-the-site-template If you want to serve the static files as a separate subsite you might find the following links helpful: https://github.com/yesodweb/yesod/wiki/Static-file-subsite-Hello-World https://groups.google.com/forum/#!msg/yesodweb/Cz8hvgiu0d0/l90NGvhAyLEJThis Hope that helps, -- Christopher Reichert irc: creichert gpg: C81D 18C8 862A 3618 1376 FFA5 6BFC A992 9955 929B -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 818 bytes Desc: not available URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/803dd199/attachment.sig> From michael at snoyman.com Sat Nov 29 16:04:47 2014 From: michael at snoyman.com (Michael Snoyman) Date: Sat, 29 Nov 2014 16:04:47 +0000 Subject: [Haskell-cafe] Hosting a static site with Yesod References: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> <5479e9ab.d7cfca0a.47be.fffffade@mx.google.com> Message-ID: <CAKA2JgLT6zLr4beE4BE-M9+FrVM+6yi0DTOZWwLHTsDhWU446g@mail.gmail.com> I just wrote an answer to this on StackOverflow: http://stackoverflow.com/questions/27200701/hosting-a-static-site-with-yesod/27204171#27204171 On Sat, Nov 29, 2014, 5:43 PM Christopher Reichert <creichert07 at gmail.com> wrote: > > > On Sat, Nov 29 2014, Yifan Yu <yvifan at gmail.com> wrote: > > Hi all, > > > > I'm experimenting with Yesod and I've created a simple scaffolding site > > with yesod. I've downloaded a bootstrap template site and wish to simply > > host this site with yesod. The template site has an index.html and a > bunch > > of css and js files. This seemly simple task has baffled me. By my > > understanding, the site should be placed under the 'static' directory, I > > tried to use sendFile to send the index.html file in getHomeR, but only > the > > content of the that file is displayed, without the css and js. Should I > do > > this with a Subsite? > > > > You might want to try the question on the Yesod mailing lists if you > don't find your answer here. > > A simple solution would be to just port the index.html to hamlet and put > that directly in the ./templates/homepage.hamlet file. The > homepage.hamlet file is complimented by a homepage.julius and > homepage.lucius file which takes a flavor of javascript and css, > respectively. In Yesod, the combination of these files is known as a > widget. > > You can move your javascript and css into those widget files directly or > you can put them in your static dir (but your html is served from > homepage.hamlet by default in the scaffold). > > The static directory is already a subsite for static resources (see the > config/routes file). > > Also see the section "widgetFile" in this Yesod Book chapter: > http://www.yesodweb.com/book/scaffolding-and-the-site-template > > If you want to serve the static files as a separate subsite you might > find the following links helpful: > > https://github.com/yesodweb/yesod/wiki/Static-file-subsite-Hello-World > https://groups.google.com/forum/#!msg/yesodweb/ > Cz8hvgiu0d0/l90NGvhAyLEJThis > > Hope that helps, > > -- > Christopher Reichert > irc: creichert > gpg: C81D 18C8 862A 3618 1376 FFA5 6BFC A992 9955 929B > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/55352b3e/attachment.html> From anton.kholomiov at gmail.com Sat Nov 29 20:10:56 2014 From: anton.kholomiov at gmail.com (Anton Kholomiov) Date: Sun, 30 Nov 2014 00:10:56 +0400 Subject: [Haskell-cafe] [haskell art] Music made with Haskell In-Reply-To: <20141129130931.GA3953@x60s.casa> References: <CADDxdqMtpxcBs7L9f_rGkRz159SOT2m_M9DhiqR3vqBLCH2PtQ@mail.gmail.com> <20141129130931.GA3953@x60s.casa> Message-ID: <CADDxdqM6X320tjYf2rVy0hWXTkAMgzK8XbHbkvFY49-cTpUP1g@mail.gmail.com> You can listen in the ghci! ghci >:l Celtic.hs > main It relies on csound-sampler. Which can be installed from Hackage with cabal: cabal install csound-sampler And the csound should be installed. See csounds.com 2014-11-29 17:09 GMT+04:00 Francesco Ariis <fa-ml at ariis.it>: > On Fri, Nov 28, 2014 at 12:47:48PM +0400, Anton Kholomiov wrote: > > I wrote two tracks completely with Haskell. > > You can listen to them on the soundcloud: > > I downloaded the zip'd source, but I cannot listen to your track > on soundcloud (it requires Flash, and Linux doesn't play well > with Flash). > Is there any other place I can download them from? > > -- > > Read the whole topic here: Haskell Art: > http://lurk.org/r/topic/1oAxdkhuHG8pZxAtD1skqT > > To leave Haskell Art, email haskell-art at group.lurk.org with the following > email subject: unsubscribe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/bce7300b/attachment.html> From vogt.adam at gmail.com Sat Nov 29 20:29:56 2014 From: vogt.adam at gmail.com (adam vogt) Date: Sat, 29 Nov 2014 15:29:56 -0500 Subject: [Haskell-cafe] extensible effects and open unions In-Reply-To: <87h9xjzm7t.fsf_-_@chaos.shergill.su> References: <CAJEmqMj8Y7KoNVPS7x6zvvtkAmYheax9oigTPLLHDchfHde_pA@mail.gmail.com> <20130823080608.45461.qmail@www1.g3.pair.com> <87h9xjzm7t.fsf_-_@chaos.shergill.su> Message-ID: <CAHfjoW=eKT0dXokWs3m-crAGyRmKx1QsNnjec2+OgQO7nGV9yg@mail.gmail.com> Hi Suhail, On Fri, Nov 28, 2014 at 4:52 AM, Suhail Shergill <suhailshergill at gmail.com> wrote: > having recently taken over as maintainer for the extensible-effects library, i'm > looking to address some of the current implementation concerns. specifically: > > 1] the use/need for Typeable in Data.OpenUnion > how does the TList.hs implementation compare with, say, OpenUnion2.hs? neither > require OverlappingInstances, and the TList implementation also does away with > the Typeable constraint. are there reasons why it might not make sense to use > TList.hs as the only/default implementation of Data.OpenUnion? You need to write an instance of TCode for every different "effect" included in the union for the lookup to work. Check out this example usage of TList.hs: mkV :: Int -> ([] :> Maybe :> Void) Int mkV 1 = H [1,2,3] mkV 2 = T (H (Just 5)) mkV 3 = T (T (undefined :: Void Int)) -- | >>> test1 -- [Just [1,2,3],Nothing,Nothing] test1 :: [Maybe [Int]] test1 = map (prj . mkV) [1 .. 3] -- | >>> test2 -- [Nothing,Just (Just 5),Nothing] test2 :: [Maybe (Maybe Int)] test2 = map (prj . mkV) [1 .. 3] type instance TCode [] = Z type instance TCode Maybe = S Z If you instead had type instance TCode [] = Z type instance TCode Maybe = Z then test2 would not typecheck, and the type error doesn't suggest (to me) that the TCode instances are wrong. I think you're better off depending on a type family Eq :: Bool where Eq x x = True Eq x y = False Or the equivalent with overlapping instances if the code is supposed to work with ghc-7.6. Another objection about TList is that it is a linked list, so operations with types at the "end" of the union are probably relatively slow at runtime, since you end up pattern matching on "n" T constructors in some cases. It might be faster to have more of that traversal done at compile time as in: http://code.haskell.org/HList/Data/HList/Variant.hs Or with unions that use Typeable. I'm not sure about your other questions. Regards, Adam From gautier.difolco at gmail.com Sun Nov 30 00:35:46 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Sun, 30 Nov 2014 01:35:46 +0100 Subject: [Haskell-cafe] Kind signatures and closed type families syntax Message-ID: <CAH_3vcS6Gf0BGUeT8sycxd4OD1-Bk1ftmVcU55RkQYsZhrcsaA@mail.gmail.com> Hello all, I have the following code: {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} data Branch = Left | Right type family Product (v :: Branch) (a :: k) (b :: k) :: k where Product Left l r = l Product Right l r = r He is doing what I expect it to do and Product has the right Kind: *Main> :kind Product Product :: Branch -> k -> k -> k But when I change the Kind signature syntax, its Kind changes: type family Product v a b :: Branch -> k -> k -> k where Its Kind become: *Main> :kind Product Product :: Branch -> (Branch -> k -> k -> k) -> (Branch -> k1 -> k1 -> k1) -> Branch -> k2 -> k2 -> k2 It's even worse with this syntax: type family Product :: Branch -> k -> k -> k where Produces: *Main> :r [1 of 1] Compiling Main ( product-highkind.hs, interpreted ) product-highkind.hs:13:3: Number of parameters must match family declaration; expected 0 In the equations for closed type family ?Product? In the type family declaration for ?Product? Failed, modules loaded: none. I don't know if I'm tired or not but in the documentation [1] these syntaxes should be equivalent. If not, I'll take any explanations. Thanks in advance for your help. [1] https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/kind-polymorphism.html -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/ec92c9a5/attachment.html> From gautier.difolco at gmail.com Sun Nov 30 00:43:19 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Sun, 30 Nov 2014 01:43:19 +0100 Subject: [Haskell-cafe] Kind product Message-ID: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> Hello all, I have the following code: {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} data Branch = Left | Right type family Product (v :: Branch) (a :: k) (b :: k) :: k where Product Left l r = l Product Right l r = r My goal is to have a thing like that: type family Product (v :: Branch) (a :: k1) (b :: k2) :: (Either k1 k2) where Is it possible to do such a thing? If not I can find a solution with Kind families/Kind pattern matching, but I don't think that exists, am I wrong? Thanks in advance for your help, Regards. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/94f10984/attachment.html> From itten at yandex.ru Sun Nov 30 02:03:30 2014 From: itten at yandex.ru (=?koi8-r?B?5M3J1NLJyg==?=) Date: Sun, 30 Nov 2014 08:03:30 +0600 Subject: [Haskell-cafe] Haskell 2014 Message-ID: <137871417313010@web12h.yandex.ru> An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/5d626a8f/attachment.html> From karl at karlv.net Sun Nov 30 03:42:55 2014 From: karl at karlv.net (Karl Voelker) Date: Sat, 29 Nov 2014 19:42:55 -0800 Subject: [Haskell-cafe] Kind signatures and closed type families syntax In-Reply-To: <CAH_3vcS6Gf0BGUeT8sycxd4OD1-Bk1ftmVcU55RkQYsZhrcsaA@mail.gmail.com> References: <CAH_3vcS6Gf0BGUeT8sycxd4OD1-Bk1ftmVcU55RkQYsZhrcsaA@mail.gmail.com> Message-ID: <1417318975.594411.196845249.17625995@webmail.messagingengine.com> On Sat, Nov 29, 2014, at 04:35 PM, Gautier DI FOLCO wrote: > Hello all, > > I have the following code: {-# LANGUAGE NoImplicitPrelude #-} {-# > LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE > DataKinds #-} {-# LANGUAGE PolyKinds #-} > > data Branch = Left | Right > > type family Product (v :: Branch) (a :: k) (b :: k) :: k where Product > Left l r = l Product Right l r = r > > He is doing what I expect it to do and Product has the right Kind: > *Main> :kind Product Product :: Branch -> k -> k -> k > > But when I change the Kind signature syntax, its Kind changes: type > family Product v a b :: Branch -> k -> k -> k where Its Kind become: > *Main> :kind Product Product :: Branch -> (Branch -> k -> k -> k) -> > (Branch -> k1 -> k1 -> k1) -> Branch -> k2 -> k2 -> k2 In a type family declaration, the signature to the right of the top-level "::" is always the kind of the result. When you drop the kind signatures from the parameter declarations, the kinds of those parameters become inferred rather than explicit, but that doesn't change the interpretation of the top-level signature - it is still just the kind of the result. -Karl -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141129/b5922049/attachment.html> From andres.loeh at gmail.com Sun Nov 30 09:57:56 2014 From: andres.loeh at gmail.com (=?UTF-8?Q?Andres_L=C3=B6h?=) Date: Sun, 30 Nov 2014 10:57:56 +0100 Subject: [Haskell-cafe] Kind product In-Reply-To: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> References: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> Message-ID: <CALjd_v6bE+r2+15JCD6=k=MWyR6e0jT1tphHSyg90jWo2MwW6g@mail.gmail.com> Hi. [...] > My goal is to have a thing like that: > type family Product (v :: Branch) (a :: k1) (b :: k2) :: (Either k1 k2) > where I'm not sure what exactly it is that you want, but this code checks: {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-} module PairEitherKinds where data Branch = L | R type family Product (s :: Branch) (a :: k1) (b :: k2) :: Either k1 k2 where Product L a b = Left a Product R a b = Right b Cheers, Andres From gautier.difolco at gmail.com Sun Nov 30 11:28:57 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Sun, 30 Nov 2014 12:28:57 +0100 Subject: [Haskell-cafe] Kind signatures and closed type families syntax In-Reply-To: <1417318975.594411.196845249.17625995@webmail.messagingengine.com> References: <CAH_3vcS6Gf0BGUeT8sycxd4OD1-Bk1ftmVcU55RkQYsZhrcsaA@mail.gmail.com> <1417318975.594411.196845249.17625995@webmail.messagingengine.com> Message-ID: <CAH_3vcTZBv7UKvYQe3j0U98+==3sqcJ_JFgL8_8OQK6o2vWHuw@mail.gmail.com> 2014-11-30 4:42 GMT+01:00 Karl Voelker <karl at karlv.net>: > In a type family declaration, the signature to the right of the top-level > "::" is always the kind of the result. When you drop the kind signatures > from the parameter declarations, the kinds of those parameters become > inferred rather than explicit, but that doesn't change the interpretation > of the top-level signature - it is still just the kind of the result. > Hello, Thanks for your answer, it's perturbing me but that's a nice explanation. Thanks. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/ef088942/attachment.html> From roma at ro-che.info Sun Nov 30 11:46:53 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sun, 30 Nov 2014 13:46:53 +0200 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <137871417313010@web12h.yandex.ru> References: <137871417313010@web12h.yandex.ru> Message-ID: <547B03AD.2070101@ro-che.info> On 30/11/14 04:03, ??????? wrote: > Hi everyone, > > I couldn't find when haskell 2014 standard will come out. Is there any > information about it? > Somewhere I read that a new standard should be released each year but it > seems not to be true nowadays There's no-one working on the Haskell standard, to the best of my knowledge. So no, it probably won't come out. Roman From corentin.dupont at gmail.com Sun Nov 30 12:04:15 2014 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Sun, 30 Nov 2014 13:04:15 +0100 Subject: [Haskell-cafe] Data migration and software versioning Message-ID: <CAEyhvmrN=-77pLJ9YPTmy39OyxWhZiEPdmQs0R3bB1x+0NAwXQ@mail.gmail.com> Hi the list, I have some question relative to data migration. Say you have a software in version A which save data in a file with format FA. Later, you update your software to version B, with data format FB. Now, if you want your version B of the software to be able to read data saved by version A, you're obliged to include FA in version B, together with some functions to translate from FA to FB. This is what I don't find elegant: you're obliged to keep old code (data formats) in your software. -> do you know of any way to avoid keeping old data formats (for retro-compatiblilty) in your code? In practice I use acid-state with safecopy: http://acid-state.seize.it/safecopy In this example you can see the problem: the author is obliged to keep old code (data structures) to maintain compatibility. Even worth, you might be obliged to suffix your data structure with a version number: data MyType_V1 = MyType_V1 Intdata MyType_V2 = MyType_V2 Integer Instead, I'm thinking of a process using GIT, or Cabal as a back-end. The idea would be to have an additional program (or library) specialized in the data migration of your main software. It would extract both version A and B from the repo, and then would compile an application capable of handling migrations from FA to FB. Does something like this exists (even outside of Haskell)? Cheers, Corentin -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/e27273c6/attachment.html> From david.feuer at gmail.com Sun Nov 30 12:05:44 2014 From: david.feuer at gmail.com (David Feuer) Date: Sun, 30 Nov 2014 07:05:44 -0500 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <137871417313010@web12h.yandex.ru> References: <137871417313010@web12h.yandex.ru> Message-ID: <CAMgWh9tZj3822hGs87SVjon8cBV=MSaRHS0eJkOyjxwQCahGcg@mail.gmail.com> There were standards in 1998, 2003, and 2010. I don't know of any others. Some people would be interested in a new standard to cover some of the recent library changes, at least, but that is very unlikely to happen until at least 2015. On Nov 29, 2014 9:03 PM, "???????" <itten at yandex.ru> wrote: > Hi everyone, > > I couldn't find when haskell 2014 standard will come out. Is there any > information about it? > Somewhere I read that a new standard should be released each year but it > seems not to be true nowadays > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/9d105023/attachment.html> From gautier.difolco at gmail.com Sun Nov 30 12:28:56 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Sun, 30 Nov 2014 13:28:56 +0100 Subject: [Haskell-cafe] Kind product In-Reply-To: <CALjd_v6bE+r2+15JCD6=k=MWyR6e0jT1tphHSyg90jWo2MwW6g@mail.gmail.com> References: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> <CALjd_v6bE+r2+15JCD6=k=MWyR6e0jT1tphHSyg90jWo2MwW6g@mail.gmail.com> Message-ID: <CAH_3vcTzE9AKvOccBWMnBpXbqXQ238Msn4XEnXHRCvR076Hcgw@mail.gmail.com> 2014-11-30 10:57 GMT+01:00 Andres L?h <andres.loeh at gmail.com>: > Hi. > > [...] > > > My goal is to have a thing like that: > > type family Product (v :: Branch) (a :: k1) (b :: k2) :: (Either k1 k2) > > where > > I'm not sure what exactly it is that you want, but this code checks: > > {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-} > module PairEitherKinds where > > data Branch = L | R > > type family Product (s :: Branch) (a :: k1) (b :: k2) :: Either k1 k2 where > Product L a b = Left a > Product R a b = Right b > > Cheers, > Andres > Hello, I know but obtained types are wrapped in the Either kind and I try to have it directly. If I have a kind family I'll do something like this: type family SumI (s :: Branch) (a :: k1) (b :: k2) :: Max k1 k2 where SumI Left l r = Maximise a b l SumI Right l r = Maximise a b r type Sum a b = DropFlippedConst (SumI a b) type FlippedConst a b = Const b a kind Max a b c = FromJust (LeftMax a b c <|> LeftMax b a c) kind family LeftMax a b where Max * k2 = Nothing Max k k = Just k Max (k1 -> k2) k3 = (k1 ->) <$> Max k2 k3 kind Maximize a b c = FromJust (LeftMaximize a b c <|> LeftMaximize b a c) kind family LeftMaximize a b c where LeftMaximize * k1 k2 = Nothing LeftMaximize k k k = Just k LeftMaximize (k1 -> k2) k3 k4 = FlippedConst k1 <$> LeftMaximize k2 k3 k4 kind family FromJust a where Just x =x type family DropFlippedConst x where DropFlippedConst (FlippedConst a b) = DropFlippedConst b DropFlippedConst a = a I don't know if it's clearer now, let me know. Thanks, Regards. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/4c528253/attachment.html> From hjgtuyl at chello.nl Sun Nov 30 13:49:45 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 30 Nov 2014 14:49:45 +0100 Subject: [Haskell-cafe] looking for ongoing Haskell projects .. In-Reply-To: <m270oq$ovv$4@ger.gmane.org> References: <CA+0XtC-T4HnOu_M8UZK4VbjcL2Gtk_c=zbZQMzfuEE6_yLGP2Q@mail.gmail.com> <m270oq$ovv$4@ger.gmane.org> Message-ID: <op.xp44pb11pz0j5l@alquantor> On Wed, 22 Oct 2014 03:20:21 +0200, Simon Michael <simon at joyful.com> wrote: > On 10/18/14 11:31 PM, Vasili I. Galchin wrote: >> >> I was just reading at http://www.haskell.org. I am looking for a >> list of currently active Haskell projects needing help .. :-) > I have created a HaskellWiki page[0] for this, and added a link from the FAQ page[1]. Regards, HenkJan van Tuyl [0] https://www.haskell.org/haskellwiki/Haskell_projects_needing_help [1] https://www.haskell.org/haskellwiki/FAQ#Which_project_can_I_join.3F -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ From roma at ro-che.info Sun Nov 30 14:59:56 2014 From: roma at ro-che.info (Roman Cheplyaka) Date: Sun, 30 Nov 2014 16:59:56 +0200 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <491361417350555@web22g.yandex.ru> References: <137871417313010@web12h.yandex.ru> <547B03AD.2070101@ro-che.info> <491361417350555@web22g.yandex.ru> Message-ID: <547B30EC.6070405@ro-che.info> The language (?GHC Haskell?) is evolving quite rapidly, it's just no-one is really interested in maintaining the standard anymore. I don't think it should disappoint you, unless you're a language researcher or compiler writer. On 30/11/14 14:29, Dmitry wrote: > Thanks for the answer, > > it's sad. > Even C++ now gets new releases every several years. > > Does anybody feel like the language is surpassed by other languages, for > example F#? > > > 30.11.2014, 17:46, "Roman Cheplyaka" <roma at ro-che.info>: >> >> On 30/11/14 04:03, ??????? wrote: >> >> Hi everyone, >> >> I couldn't find when haskell 2014 standard will come out. Is >> there any >> information about it? >> Somewhere I read that a new standard should be released each year >> but it >> seems not to be true nowadays >> >> There's no-one working on the Haskell standard, to the best of my >> knowledge. So no, it probably won't come out. >> >> Roman >> From nicola.gigante at gmail.com Sun Nov 30 15:25:36 2014 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Sun, 30 Nov 2014 16:25:36 +0100 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <547B30EC.6070405@ro-che.info> References: <137871417313010@web12h.yandex.ru> <547B03AD.2070101@ro-che.info> <491361417350555@web22g.yandex.ru> <547B30EC.6070405@ro-che.info> Message-ID: <54EA2BCB-7F32-42C6-9D09-14346EBAAAF5@gmail.com> Il giorno 30/nov/2014, alle ore 15:59, Roman Cheplyaka <roma at ro-che.info> ha scritto: > The language (?GHC Haskell?) is evolving quite rapidly, it's just no-one > is really interested in maintaining the standard anymore. > > I don't think it should disappoint you, unless you're a language > researcher or compiler writer. Hi. I?m a newcomer to the Haskell world, coming from C++ where the standard and conformity to the standard is of great value. Given the tendency of commercial implementors to deviate with custom and often bad-designed features, having an international standard that has to be followed by anyone is a great thing (and implementors are unfortunately very good at deviating anyway). At first, the existence of the Haskell standard gave me a good impression. Haskell is not like other languages like python or Java that, at the end, have the One True Implementation. Haskell has born from the community, and there always have been a multiplicity of implementations. In this context, having a common standard to implement makes sense, to aid compatibility. But Haskell is not like C++ neither. Haskell implementations are not driven by big corps, and features that deviates from the ?standard? are not designed and implemented by marketing departments, but they are instead often the implementation of new and innovative ideas from the research world. For this reason, it?s not so useful to crystallize the language to some-years-old standard when the compilers implementors, users and researchers are so good at evolving the language in a coherent way. Here, I think, the point is the community: the language can continue to grow and evolve in the presence of multiple implementations by ensuring collaborations between the communities of the different compilers. If this continues to be done, I don?t think a formal standard, released every x years, is needed. What, I think, needs to be improved, instead, is the way the community handles the evolving of the libraries used in the haskell world, but I know that?s a whole other story. Best Regards, Nicola From hjgtuyl at chello.nl Sun Nov 30 15:38:01 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 30 Nov 2014 16:38:01 +0100 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <547B30EC.6070405@ro-che.info> References: <137871417313010@web12h.yandex.ru> <547B03AD.2070101@ro-che.info> <491361417350555@web22g.yandex.ru> <547B30EC.6070405@ro-che.info> Message-ID: <op.xp49pnrhpz0j5l@alquantor> On Sun, 30 Nov 2014 15:59:56 +0100, Roman Cheplyaka <roma at ro-che.info> wrote: > The language (?GHC Haskell?) is evolving quite rapidly, it's just no-one > is really interested in maintaining the standard anymore. > > I don't think it should disappoint you, unless you're a language > researcher or compiler writer. I think you are right, but still I hope that some day all of the Haskell Platform is within the Haskell language specification and can therefore be compiled with any standards compliant Haskell compiler. Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From hjgtuyl at chello.nl Sun Nov 30 16:29:55 2014 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 30 Nov 2014 17:29:55 +0100 Subject: [Haskell-cafe] Getting Haskell in the top 20 Message-ID: <op.xp5b35y6pz0j5l@alquantor> L.S., In the Tiobe Index[0], F# jumped from position 43 in June to 13 in July and is since than in the top twenty. What happened in July and how can we get Haskell in the top 20? Regards, Henk-Jan van Tuyl [0] http://www.tiobe.com/index.php/content/paperinfo/tpci/index.html -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From carette at mcmaster.ca Sun Nov 30 17:39:26 2014 From: carette at mcmaster.ca (Jacques Carette) Date: Sun, 30 Nov 2014 12:39:26 -0500 Subject: [Haskell-cafe] Getting Haskell in the top 20 In-Reply-To: <op.xp5b35y6pz0j5l@alquantor> References: <op.xp5b35y6pz0j5l@alquantor> Message-ID: <547B564E.9010805@mcmaster.ca> Make sure the actual words "Haskell programming" occur in as many places as possible [posts here, on reddit, on stackoverflow, etc]. Not variants of those words, but those exact words. Like you did in your .sig (although that may not be indexed, so it may need to be in the actual text). Get it into people's phrasing that they always speak of "Haskell programming", not Haskell code, coding, etc, etc. Jacques On 2014-11-30 11:29 AM, Henk-Jan van Tuyl wrote: > > L.S., > > In the Tiobe Index[0], F# jumped from position 43 in June to 13 in July > and is since than in the > top twenty. What happened in July and how can we get Haskell in the > top 20? > > Regards, > Henk-Jan van Tuyl > > > [0] http://www.tiobe.com/index.php/content/paperinfo/tpci/index.html > > From hans at hanshoglund.se Sun Nov 30 18:17:42 2014 From: hans at hanshoglund.se (=?iso-8859-1?Q?Hans_H=F6glund?=) Date: Sun, 30 Nov 2014 18:17:42 +0000 Subject: [Haskell-cafe] [Announce] Music Suite v1.8 Message-ID: <C2301E68-1870-4CE7-8646-D5CB68C6B3D6@hanshoglund.se> I am happy to announce the release of Music Suite version 1.8. This release in short: Cleaner API for dealing with Voices, Notes and time structures in general. New equal-temperament pitch representation. Improved handling of diatonic vs. chromatic transposition in the Common pitch representation. Better support for clef and staff line positions. Better support for handling instrument ambitus etc. See full notes at https://github.com/music-suite/music-docs/blob/master/releases/Notes.md#18 The Music Suite is a language for description, analysis, composition and manipulation of music embedded in Haskell. For more information see http://music-suite.github.io or my talk at FARM2014 http://functional-art.org/2014/. Regards, Hans Hoeglund - https://twitter.com/hanshogl https://soundcloud.com/hanshoglund http://github.com/hanshoglund -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/a8413683/attachment.html> From tdammers at gmail.com Sun Nov 30 19:13:43 2014 From: tdammers at gmail.com (Tobias Dammers) Date: Sun, 30 Nov 2014 20:13:43 +0100 Subject: [Haskell-cafe] Haskell 2014 In-Reply-To: <54EA2BCB-7F32-42C6-9D09-14346EBAAAF5@gmail.com> References: <137871417313010@web12h.yandex.ru> <547B03AD.2070101@ro-che.info> <491361417350555@web22g.yandex.ru> <547B30EC.6070405@ro-che.info> <54EA2BCB-7F32-42C6-9D09-14346EBAAAF5@gmail.com> Message-ID: <20141130191342.GA9849@yemaya> On Sun, Nov 30, 2014 at 04:25:36PM +0100, Nicola Gigante wrote: > > Il giorno 30/nov/2014, alle ore 15:59, Roman Cheplyaka <roma at ro-che.info> ha scritto: > > > The language (?GHC Haskell?) is evolving quite rapidly, it's just no-one > > is really interested in maintaining the standard anymore. > > > > I don't think it should disappoint you, unless you're a language > > researcher or compiler writer. > > Hi. > > I?m a newcomer to the Haskell world, coming from C++ where the standard > and conformity to the standard is of great value. > > Given the tendency of commercial implementors to deviate with custom > and often bad-designed features, having an international standard that has to be > followed by anyone is a great thing (and implementors are unfortunately > very good at deviating anyway). > > At first, the existence of the Haskell standard gave me a good impression. > Haskell is not like other languages like python or Java that, at the end, have > the One True Implementation. Haskell has born from the community, and > there always have been a multiplicity of implementations. In this context, > having a common standard to implement makes sense, to aid compatibility. > > But Haskell is not like C++ neither. Haskell implementations are not driven > by big corps, and features that deviates from the ?standard? are not designed > and implemented by marketing departments, but they are instead often the > implementation of new and innovative ideas from the research world. > > For this reason, it?s not so useful to crystallize the language to some-years-old > standard when the compilers implementors, users and researchers are so > good at evolving the language in a coherent way. > > Here, I think, the point is the community: the language can continue to > grow and evolve in the presence of multiple implementations by ensuring > collaborations between the communities of the different compilers. > If this continues to be done, I don?t think a formal standard, released > every x years, is needed. Frankly, I believe that as it stands, there only really is one industry-strength Haskell compiler - Hugs is dead, the others are either research vehicles (interesting, ground-breaking, but far from being useful alternatives to GHC for real-world applications IMO - I'd love to be corrected on this one btw), or special-purpose tools (most notably Haskell-to-JavaScript compilers like Fay) that don't even implement all of Haskell 2010, let alone the recent additions found in GHC. The need for a standard, therefor, isn't pressing enough at the moment, and the kind of well thought-out and well documented development we're seeing in GHC is enough to keep the language and its ecosystem moving at a high quality. I can understand very well that people put their money, time, and other resources, into actual features. That's fine, we currently need those more than a standard. If, at some point, an alternative compiler were to evolve (which, personally, I would consider a positive thing: diversity and a bit of healthy competition is good and can lead to great innovation boosts), standardization would move up on the priority list, just like it did for C++ when it became painfully obvious that GNU C++, clang-C++, Microsoft C++, and other serious contenders, had produced an inconsistent and incompatible mess between them that benefited nobody. We're *very* far from this in the Haskell world, and from what I've seen in the community, I don't think this is going to happen anytime soon, and if it were, we'd see a new standard sooner rather than later. (Note, btw., that one of the biggest sponsors behind GHC is Microsoft, and many of the other contributions come from commercial entities - Haskell consultancy firms, companies that use Haskell in their software ecosystem, and even companies that are built around Haskell software. Haskell has long ceased to be an ivory-tower research toy.) My $0.02 anyway. From tdammers at gmail.com Sun Nov 30 19:47:14 2014 From: tdammers at gmail.com (Tobias Dammers) Date: Sun, 30 Nov 2014 20:47:14 +0100 Subject: [Haskell-cafe] Hosting a static site with Yesod In-Reply-To: <CAKA2JgLT6zLr4beE4BE-M9+FrVM+6yi0DTOZWwLHTsDhWU446g@mail.gmail.com> References: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> <5479e9ab.d7cfca0a.47be.fffffade@mx.google.com> <CAKA2JgLT6zLr4beE4BE-M9+FrVM+6yi0DTOZWwLHTsDhWU446g@mail.gmail.com> Message-ID: <20141130194713.GC9849@yemaya> Out of interest; why would you use Yesod for this? It's a great platform for sure, but way overkill for serving a bunch of static files IMO - all you need, really, would be a simple single-file Scotty app, I'd think. On Sat, Nov 29, 2014 at 04:04:47PM +0000, Michael Snoyman wrote: > I just wrote an answer to this on StackOverflow: > http://stackoverflow.com/questions/27200701/hosting-a-static-site-with-yesod/27204171#27204171 > > On Sat, Nov 29, 2014, 5:43 PM Christopher Reichert <creichert07 at gmail.com> > wrote: > > > > > > > On Sat, Nov 29 2014, Yifan Yu <yvifan at gmail.com> wrote: > > > Hi all, > > > > > > I'm experimenting with Yesod and I've created a simple scaffolding site > > > with yesod. I've downloaded a bootstrap template site and wish to simply > > > host this site with yesod. The template site has an index.html and a > > bunch > > > of css and js files. This seemly simple task has baffled me. By my > > > understanding, the site should be placed under the 'static' directory, I > > > tried to use sendFile to send the index.html file in getHomeR, but only > > the > > > content of the that file is displayed, without the css and js. Should I > > do > > > this with a Subsite? > > > > > > > You might want to try the question on the Yesod mailing lists if you > > don't find your answer here. > > > > A simple solution would be to just port the index.html to hamlet and put > > that directly in the ./templates/homepage.hamlet file. The > > homepage.hamlet file is complimented by a homepage.julius and > > homepage.lucius file which takes a flavor of javascript and css, > > respectively. In Yesod, the combination of these files is known as a > > widget. > > > > You can move your javascript and css into those widget files directly or > > you can put them in your static dir (but your html is served from > > homepage.hamlet by default in the scaffold). > > > > The static directory is already a subsite for static resources (see the > > config/routes file). > > > > Also see the section "widgetFile" in this Yesod Book chapter: > > http://www.yesodweb.com/book/scaffolding-and-the-site-template > > > > If you want to serve the static files as a separate subsite you might > > find the following links helpful: > > > > https://github.com/yesodweb/yesod/wiki/Static-file-subsite-Hello-World > > https://groups.google.com/forum/#!msg/yesodweb/ > > Cz8hvgiu0d0/l90NGvhAyLEJThis > > > > Hope that helps, > > > > -- > > Christopher Reichert > > irc: creichert > > gpg: C81D 18C8 862A 3618 1376 FFA5 6BFC A992 9955 929B > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From eir at cis.upenn.edu Sun Nov 30 20:05:35 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 30 Nov 2014 15:05:35 -0500 Subject: [Haskell-cafe] multiple declarations error in Haskell - should it be relaxed? In-Reply-To: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> References: <301AB453-0F66-4F78-9CFC-E27EE087E17B@scss.tcd.ie> Message-ID: <7ADE2491-1187-4928-9809-5549CBF236A1@cis.upenn.edu> This seems reasonable to me. If you want this, post a feature request at https://ghc.haskell.org/trac/ghc/newticket Richard On Nov 28, 2014, at 6:44 AM, Andrew Butterfield <Andrew.Butterfield at scss.tcd.ie> wrote: > Condsider the following Haskell program (fragment): > > f 0 = ?zero? > g 0 = ?NULL? > f n = ?non-zero? > g n = ?PRESENT? > > This will result in two ?Multiple Declaration? errors. > There is a good motivation for this - disallowing such an interleaving > of declarations makes it easy for the compiler to capture a common > typo, namely errors of the following form - here an attempt to define > a single function called myFun. > > myFun 0 = ?zero? > myfun 1 = ?one? > myFun n = ?too big!? > > However I have use-cases where it would be nice to interleave as per > the first example above - with markedly different function names. > It invokes a large case analysis, where I have other auxiliary functions > associated with each case, but which I?d like to > (1) have at the top-level for testability > (2) keep textually local to the case with which they are associated. > > I don?t think there is a language extension to disable the multiple > declaration check - but would such a feature we possible. I?d see it > as one which still performs the check, but issues a warning rather > than an error - particularly if it notices that the interleaved names > are very similar. > > Is this a reasonable suggestion, or are there other reasons for not doing > this that I?ve missed? > > Maybe there is a better way to satisfy (1) and (2) above? > > Regards, > Andrew > -------------------------------------------------------------------- > Andrew Butterfield Tel: +353-1-896-2517 Fax: +353-1-677-2204 > Lero at TCD, Head of Foundations & Methods Research Group > School of Computer Science and Statistics, > Room G.39, O'Reilly Institute, Trinity College, University of Dublin > http://www.scss.tcd.ie/Andrew.Butterfield/ > -------------------------------------------------------------------- > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From eir at cis.upenn.edu Sun Nov 30 20:43:52 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 30 Nov 2014 15:43:52 -0500 Subject: [Haskell-cafe] Kind product In-Reply-To: <CAH_3vcTzE9AKvOccBWMnBpXbqXQ238Msn4XEnXHRCvR076Hcgw@mail.gmail.com> References: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> <CALjd_v6bE+r2+15JCD6=k=MWyR6e0jT1tphHSyg90jWo2MwW6g@mail.gmail.com> <CAH_3vcTzE9AKvOccBWMnBpXbqXQ238Msn4XEnXHRCvR076Hcgw@mail.gmail.com> Message-ID: <D7153741-85BC-44D6-B877-397598698B4D@cis.upenn.edu> If Andres's solution isn't what you want, you probably really do need kind families. They're on the way, as part of my ongoing work in making GHC more dependently typed. Definitely not expected for 7.10, but perhaps for the following release. Out of curiosity, what are you trying to do here? Thanks, Richard On Nov 30, 2014, at 7:28 AM, Gautier DI FOLCO <gautier.difolco at gmail.com> wrote: > 2014-11-30 10:57 GMT+01:00 Andres L?h <andres.loeh at gmail.com>: > Hi. > > [...] > > > My goal is to have a thing like that: > > type family Product (v :: Branch) (a :: k1) (b :: k2) :: (Either k1 k2) > > where > > I'm not sure what exactly it is that you want, but this code checks: > > {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-} > module PairEitherKinds where > > data Branch = L | R > > type family Product (s :: Branch) (a :: k1) (b :: k2) :: Either k1 k2 where > Product L a b = Left a > Product R a b = Right b > > Cheers, > Andres > > > Hello, > > I know but obtained types are wrapped in the Either kind and I try to have it directly. If I have a kind family I'll do something like this: > > type family SumI (s :: Branch) (a :: k1) (b :: k2) :: Max k1 k2 where > SumI Left l r = Maximise a b l > SumI Right l r = Maximise a b r > > type Sum a b = DropFlippedConst (SumI a b) > > type FlippedConst a b = Const b a > > kind Max a b c = FromJust (LeftMax a b c <|> LeftMax b a c) > kind family LeftMax a b where > Max * k2 = Nothing > Max k k = Just k > Max (k1 -> k2) k3 = (k1 ->) <$> Max k2 k3 > > kind Maximize a b c = FromJust (LeftMaximize a b c <|> LeftMaximize b a c) > kind family LeftMaximize a b c where > LeftMaximize * k1 k2 = Nothing > LeftMaximize k k k = Just k > LeftMaximize (k1 -> k2) k3 k4 = FlippedConst k1 <$> LeftMaximize k2 k3 k4 > > kind family FromJust a where > Just x =x > > type family DropFlippedConst x where > DropFlippedConst (FlippedConst a b) = DropFlippedConst b > DropFlippedConst a = a > > I don't know if it's clearer now, let me know. > > Thanks, > Regards. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/f2c2be33/attachment.html> From yvifan at gmail.com Sun Nov 30 22:17:45 2014 From: yvifan at gmail.com (Yifan Yu) Date: Mon, 1 Dec 2014 00:17:45 +0200 Subject: [Haskell-cafe] Hosting a static site with Yesod In-Reply-To: <20141130194713.GC9849@yemaya> References: <CA+E_Kpb=_gaPRU6Px9Jt=b=RyvScQmBA+t=71uNh=5+omD8NdQ@mail.gmail.com> <5479e9ab.d7cfca0a.47be.fffffade@mx.google.com> <CAKA2JgLT6zLr4beE4BE-M9+FrVM+6yi0DTOZWwLHTsDhWU446g@mail.gmail.com> <20141130194713.GC9849@yemaya> Message-ID: <CA+E_KpasBcQQXs15=k0QGVOvfmiuwgvy2D75ygMXqa=WstHf4w@mail.gmail.com> Thank you everyone and sorry for the late reply. The problem is solved and I think I'm gonna read more on the Yesod book and web programming in general. The reason that I'm using Yesod for this is that I want to start with something static, say a template site, make it work first so I can have something to start with, and then gradually add the RESTful contents. On Sun, Nov 30, 2014 at 9:47 PM, Tobias Dammers <tdammers at gmail.com> wrote: > Out of interest; why would you use Yesod for this? It's a great platform > for sure, but way overkill for serving a bunch of static files IMO - all > you need, really, would be a simple single-file Scotty app, I'd think. > > On Sat, Nov 29, 2014 at 04:04:47PM +0000, Michael Snoyman wrote: > > I just wrote an answer to this on StackOverflow: > > > http://stackoverflow.com/questions/27200701/hosting-a-static-site-with-yesod/27204171#27204171 > > > > On Sat, Nov 29, 2014, 5:43 PM Christopher Reichert < > creichert07 at gmail.com> > > wrote: > > > > > > > > > > > On Sat, Nov 29 2014, Yifan Yu <yvifan at gmail.com> wrote: > > > > Hi all, > > > > > > > > I'm experimenting with Yesod and I've created a simple scaffolding > site > > > > with yesod. I've downloaded a bootstrap template site and wish to > simply > > > > host this site with yesod. The template site has an index.html and a > > > bunch > > > > of css and js files. This seemly simple task has baffled me. By my > > > > understanding, the site should be placed under the 'static' > directory, I > > > > tried to use sendFile to send the index.html file in getHomeR, but > only > > > the > > > > content of the that file is displayed, without the css and js. > Should I > > > do > > > > this with a Subsite? > > > > > > > > > > You might want to try the question on the Yesod mailing lists if you > > > don't find your answer here. > > > > > > A simple solution would be to just port the index.html to hamlet and > put > > > that directly in the ./templates/homepage.hamlet file. The > > > homepage.hamlet file is complimented by a homepage.julius and > > > homepage.lucius file which takes a flavor of javascript and css, > > > respectively. In Yesod, the combination of these files is known as a > > > widget. > > > > > > You can move your javascript and css into those widget files directly > or > > > you can put them in your static dir (but your html is served from > > > homepage.hamlet by default in the scaffold). > > > > > > The static directory is already a subsite for static resources (see the > > > config/routes file). > > > > > > Also see the section "widgetFile" in this Yesod Book chapter: > > > http://www.yesodweb.com/book/scaffolding-and-the-site-template > > > > > > If you want to serve the static files as a separate subsite you might > > > find the following links helpful: > > > > > > https://github.com/yesodweb/yesod/wiki/Static-file-subsite-Hello-World > > > https://groups.google.com/forum/#!msg/yesodweb/ > > > Cz8hvgiu0d0/l90NGvhAyLEJThis > > > > > > Hope that helps, > > > > > > -- > > > Christopher Reichert > > > irc: creichert > > > gpg: C81D 18C8 862A 3618 1376 FFA5 6BFC A992 9955 929B > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > Haskell-Cafe at haskell.org > > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://www.haskell.org/mailman/listinfo/haskell-cafe > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141201/257ff590/attachment.html> From gautier.difolco at gmail.com Sun Nov 30 22:38:29 2014 From: gautier.difolco at gmail.com (Gautier DI FOLCO) Date: Sun, 30 Nov 2014 23:38:29 +0100 Subject: [Haskell-cafe] Kind product In-Reply-To: <D7153741-85BC-44D6-B877-397598698B4D@cis.upenn.edu> References: <CAH_3vcSM+otw8K979ToyZJT5dR-vMC6B+4k2BOZsYcJVJus08w@mail.gmail.com> <CALjd_v6bE+r2+15JCD6=k=MWyR6e0jT1tphHSyg90jWo2MwW6g@mail.gmail.com> <CAH_3vcTzE9AKvOccBWMnBpXbqXQ238Msn4XEnXHRCvR076Hcgw@mail.gmail.com> <D7153741-85BC-44D6-B877-397598698B4D@cis.upenn.edu> Message-ID: <CAH_3vcQ8mf2WYzWfNUunNfbOOQejkXb2sNbieaNu99fhrZ83ww@mail.gmail.com> 2014-11-30 21:43 GMT+01:00 Richard Eisenberg <eir at cis.upenn.edu>: > If Andres's solution isn't what you want, you probably really do need kind > families. They're on the way, as part of my ongoing work in making GHC more > dependently typed. Definitely not expected for 7.10, but perhaps for the > following release. > > Out of curiosity, what are you trying to do here? > Hello, Thanks for your answer. I don't see why it's closer to dependent typing, can you give me some hints? Thanks, Regards. PS: in fact I'm trying to write an introduction of Haskell without value-expression and I cheat a lot because types have became my values and Kinds my types. I'm a little bit frustrated to don't be able to treat them uniformly, the distinction type-level/value-level seems very strong at this time. -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/0e6780d3/attachment.html> From yasu at yasuaki.com Sun Nov 30 23:55:18 2014 From: yasu at yasuaki.com (Yasuaki Kudo) Date: Mon, 1 Dec 2014 08:55:18 +0900 Subject: [Haskell-cafe] Typeclass Show Question Message-ID: <008201d00cf9$1aca4d00$505ee700$@yasuaki.com> Hi, When I launch GHCI with the option -XGADTs and load the following program, f = \x y -> (1, x,y) data S a b where S :: (Num a, Num b) => a -> b -> S a b I encounter this dialog: *Main> S 1 1 <interactive>:3:1: No instance for (Show (S a0 b0)) arising from a use of `print' Possible fix: add an instance declaration for (Show (S a0 b0)) In a stmt of an interactive GHCi command: print it I tried to follow the recommendation but still could not figure out how. For example, after adding: instance Show (S a b) where show (S x y) = show(x) I still get: conmath.hs:10:24: Could not deduce (Show a) arising from a use of `show' from the context (Num a, Num b) bound by a pattern with constructor S :: forall a b. (Num a, Num b) => a -> b -> S a b, in an equation for `show' at conmath.hs:10:15-19 Possible fix: add (Show a) to the context of the data constructor `S' or the instance declaration In the expression: show (x) In an equation for `show': show (S x y) = show (x) In the instance declaration for `Show (S a b)' Failed, modules loaded: none. What should I do to show S 1 1 ? Regards, Yasu -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141201/ff51db67/attachment.html> From kai at kzhang.org Sun Nov 30 23:59:22 2014 From: kai at kzhang.org (Kai Zhang) Date: Sun, 30 Nov 2014 15:59:22 -0800 Subject: [Haskell-cafe] Typeclass Show Question In-Reply-To: <008201d00cf9$1aca4d00$505ee700$@yasuaki.com> References: <008201d00cf9$1aca4d00$505ee700$@yasuaki.com> Message-ID: <CACh019mZ-GjByE1ej-sSF+Fju1oFnM2Faxm3Qi++gFnpPFng4A@mail.gmail.com> The type "a" in S a b must be an instance of "Show" in order to use "show". So you need: instance Show a => Show (S a b) where show (S x y) = show x On Sun, Nov 30, 2014 at 3:55 PM, Yasuaki Kudo <yasu at yasuaki.com> wrote: > Hi, > > > > When I launch GHCI with the option ?XGADTs and load the following program, > > > > f = \x y -> (1, x,y) > > > > data S a b where > > S :: (Num a, Num b) => a -> b -> S a b > > > > > > I encounter this dialog: > > *Main> S 1 1 > > > > <interactive>:3:1: > > No instance for (Show (S a0 b0)) > > arising from a use of `print' > > Possible fix: add an instance declaration for (Show (S a0 b0)) > > In a stmt of an interactive GHCi command: print it > > > > > > I tried to follow the recommendation but still could not figure out how. > For example, after adding: > > > > instance Show (S a b) where > > show (S x y) = show(x) > > I still get: > > conmath.hs:10:24: > > Could not deduce (Show a) arising from a use of `show' > > from the context (Num a, Num b) > > bound by a pattern with constructor > > S :: forall a b. (Num a, Num b) => a -> b -> S a b, > > in an equation for `show' > > at conmath.hs:10:15-19 > > Possible fix: > > add (Show a) to the context of > > the data constructor `S' > > or the instance declaration > > In the expression: show (x) > > In an equation for `show': show (S x y) = show (x) > > In the instance declaration for `Show (S a b)' > > Failed, modules loaded: none. > > > > What should I do to show S 1 1 ? > > > > Regards, > > Yasu > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141130/17596d0e/attachment-0001.html>