Re: [Haskell-cafe] One-element tuple

2013-08-19 Thread Daniel F
Can you please elaborate why this inconsistency is annoying and what's the
use of OneTuple?
Genuine question,
thanks.


On Fri, Aug 16, 2013 at 5:35 AM, AntC anthony_clay...@clear.net.nz wrote:

 There's an annoying inconsistency:

 (CustId 47, CustName Fred, Gender Male)  -- threeple
 (CustId 47, CustName Fred)-- twople
 --  (CustId 47)-- oneple not!
 () -- nople

 (That is, it's annoying if you're trying to make typeclass instances for
 extensible/contractable tuples. Yes, I know I could use HLists.)

 I'm not happy with either approach I've tried:

 data Oneple a = Oneple a   -- (or newtype)
 (Oneple $ CustId 47)   -- too verbose

 type Oneple a = [a]
 [CustId 47]  -- at least looks bracket-y

 What do you do?

 AntC



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




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


Re: [Haskell-cafe] Errors in non-monadic code

2013-08-19 Thread Daniel F
On Mon, Aug 19, 2013 at 9:48 PM, jabolo...@google.com wrote:

 Hi,


Hello!


 What is the proper way to implement a non-monadic function that checks
 whether a given value is correct and gives a proper error message
 otherwise ? What is the recommended option ?


I am not sure, what do you mean by non-monadic. Both (Either String) and
Maybe are monads.

You can pick up whatever option you like, depending on which option, in
your opinion, suits you better for your specific case.
There is also a helpful errors [1] package that provide convenient means of
converting between the results of the two approaches.

Control.Error.Util.hush :: Either a b - Maybe b
Control.Error.Util.note :: a - Maybe b - Either a b


 * Either String a

 check val
   | valid val = Right val
   | otherwise = Left errorMsg


 * Maybe String

 check val
   | valid val = Nothing
   | otherwise = Just errorMsg


 Cheers,
 Jose

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


[1] http://hackage.haskell.org/package/errors

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


[Haskell-cafe] ANN: restricted-workers-0.1

2013-08-12 Thread Daniel F
Introducing: restricted-workers library, version 0.1.0.

This library provides an abstract interface for running various kinds
of workers under resource restrictions. It is being developed as part
of the interactive-diagrams project and you can read more about the
origins of the library in my GSoC report:
http://parenz.wordpress.com/2013/07/15/interactive-diagrams-gsoc-progress-report/

The library provides a convenient way of running worker processes,
saving data obtained by the workers at start-up, a simple pool
abstraction and a configurable security and resource limitations.

Right now there are several kinds of security restrictions that could
be applied to the worker process:

- RLimits
- chroot jail
- custom process euid
- cgroups
- process niceness
- SELinux security context

You can read more about the library on the wiki:
https://github.com/co-dan/interactive-diagrams/wiki/Restricted-Workers

The library has been uploaded to hackage and you can install it using
cabal-install.


-- 
Thanks
-- Daniil Frumin

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


Re: [Haskell-cafe] Dual-licensing the package on Hackage

2013-07-30 Thread Daniel F
I second this.

Also, I would like to point out that the product you get from Hackage
(the source code) will be licensed under the GPL. Nobody can get the
commercial version of the product from Hackage, as one has to contact
you (the owner) directly or in some other manner.

I guess that is what Thu is trying to say.

On Tue, Jul 30, 2013 at 3:03 PM, Vo Minh Thu not...@gmail.com wrote:
 No. If I provide a library to you stating you can use it under the
 term of the GPL3, this does not prevent me from providing it to
 someone else under a different license (provided I have the rights to
 do so, for instance because I am the copyright owner).

 So as far as you're concerned (and this is the case with Hackage in
 this dicussion), the library is provided under the terms of the GPL.
 There is no point saying but if you pay me I can provide it under
 some other terms.

 2013/7/30 Jan Stolarek jan.stola...@p.lodz.pl:
 I'd say OtherLicense because:

   data License = GPL3

 is different from

   data License = Commercial | GPL3

 I hope this analogy to Haskell data types is convincing :)

 Janek

 - Oryginalna wiadomość -
 Od: David Sorokin david.soro...@gmail.com
 Do: Vo Minh Thu not...@gmail.com
 DW: Haskell Cafe haskell-cafe@haskell.org
 Wysłane: wtorek, 30 lipiec 2013 11:46:00
 Temat: Re: [Haskell-cafe] Dual-licensing the package on Hackage

 I am inclined to use value OtherLicense but state in the description
 that the package is available either under GPL or a commercial license.
 The latter must be requested to me. Then there would be no required
 additional steps to use the package under GPL. Only the LICENSE file
 must be appropriate. Probably, I will need two files LICENSE and
 LICENSE-GPLv3. In the former I will have add my copyright and write in a
 simple form that the license is dual and everyone is free to use the
 library under GPLv3 (which is the main use case) according the terms
 provided in the corresponded second file.

 Thanks,
 David

 On 30.07.2013 13:57, Vo Minh Thu wrote:
 Unless you want to provide multiple open source licenses, I don't see the 
 point:

 Anybody that needs a commercial license (and has some money) will
 simply ask for such a commercial license when seeing that the code is
 available under GPL.

 Another reason it is pointless is that you will certainly not want to
 list all the commercial licenses you have used/will use with different
 clients (there are virtually infinite commercial licenses that you can
 invent as needs arise: per seat, per core, per year, and so on
 depending on the clients/projects).

 I.e. you don't need to state upfront that commercial licences exist
 (although I understand that you think it is better to advertise your
 willingness to provide such commercial license, but a comment is
 enough, the fact is that license is not provided through Hackage).

 2013/7/30 Krzysztof Skrzętnicki gte...@gmail.com:
 Perhaps it would be best if .cabal allowed to have more than one license
 listed.

 Another solution would be to use custom field, for example:

 License: GPL
 x-Other-License: Commercial, see License-Commercial.txt

 All best,
 Krzysztof Skrzętnicki

 On Tue, Jul 30, 2013 at 11:44 AM, David Sorokin david.soro...@gmail.com
 wrote:
 Thanks Thu,

 I agree with you. Just I don't know what to write in the license field of
 the .cabal file: GPL or OtherLicense. The both choices seem correct to me
 and misleading at the same time.

 Cheers,
 David

 30.07.2013, в 12:53, Vo Minh Thu написал(а):

 2013/7/30 David Sorokin david.soro...@gmail.com:
 Hi, Cafe!

 Probably, it was asked before but I could not find an answer with help
 of Google.

 I have a library which is hosted on Hackage. The library is licensed
 under BSD3. It is a very specialized library for a small target group. 
 Now
 I'm going to relicense it and release a new version already under the
 dual-license: GPLv3 and commercial. In most cases GPL will be 
 sufficient as
 this is not a library in common sense.

 Can I specify the GPL license in the .cabal file, or should I write
 OtherLicense?

 I'm going to add the information about dual-licensing in the
 description section of the .cabal file, though.
 Although you can indeed license your software under different
 licences, in the case of your question it doesn't seem to be a concern
 with Hackage:

 The license displayed on Hackage is the one for the corresponding
 .cabal file (or at least I think it is). So you issue your new version
 with the changed license, the new version is available with the new
 license, the old versions are still available with the old license.
 Everything is fine.

 Now about the dual licensing. It seems it is again not a problem with
 Hackage: you are not granting through Hackage such a commercial
 license. I guess you provide it upon request (for some money). I.e.
 when I download your library from Hackage, I receive it under the
 terms of the BSD (or GPL) license you have chosen, not under a
 commercial 

Re: [Haskell-cafe] What have happened to haskell.org?

2013-07-15 Thread Daniel F
The web site is migrating.
IRC says: Topic for #haskell: haskell.org in the middle of migration;
expect turbulence; use  www.haskell.org

On Mon, Jul 15, 2013 at 6:19 PM, Kirill Zaborsky qri...@gmail.com wrote:
 On URL http://haskell.org/ I get starting Apache page and 404 on
 http://haskell.org/hoogle/
 URL with starting www - http://www.haskell.org/ seems to be working but
 http://www.haskell.org/hoogle/ responds with some ELF file.

 Kind regards,
 Kirill Zaborsky

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




--
Sincerely yours,
-- Daniil


-- 
Sincerely yours,
-- Daniil

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


Re: [Haskell-cafe] Hoogle problems?

2013-07-15 Thread Daniel F
The web site is migrating.
IRC says: Topic for #haskell: haskell.org in the middle of migration;
expect turbulence; use  www.haskell.org

On Mon, Jul 15, 2013 at 5:35 PM, Andrew Butterfield
andrew.butterfi...@scss.tcd.ie wrote:
 I've just tried using Hoogle, but either get a 404 not found
 (http://haskell.org/hoogle/) or else I find I get a ELF 64-bit
 LSB executable being downloaded

 If I search using Google and click on the first link
 (shown as www.haskell.org/hoogle/
 I get the following (spaces deliberately added to make it less dangerous)
 https://www.goo gle.com/url?sa=trct=jq=esrc=ssou 
 rce=webcd=1cad=rjaved=0CC8QFjAAurl=http%3A%2F%2Fwww.haskell.org%2Fhoogle%2Fei=y_njUdZAhY
  7sBsGpgNAKusg=AFQjCNFljq5Oyb4LT7VF-I5MUotq512AQgsig2 
 =SVRE_6nF3bhho7-NKqEaCwbvm=bv.487 05608,d.ZGU

 Using Mac OS X 10.6, Chrome and Safari

 Is it me, or is there a wider problem ?
 
 Andrew Butterfield Tel: +353-1-896-2517 Fax: +353-1-677-2204
 Lero@TCD, Head of Foundations  Methods Research Group
 Director of Teaching and Learning - Undergraduate,
 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@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe



-- 
Sincerely yours,
-- Daniil

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


[Haskell-cafe] [GSoC] Interactive-diagrams GSoC progress report

2013-07-15 Thread Daniel F
Hello everyone,
I am participating in Haskell.org's Google Summer of Code, working on
the interactive-diagrams [1] project.

The mid-term evaluations are approaching and I am doing some writeup
on the work I did so far:
http://parenz.wordpress.com/2013/07/15/interactive-diagrams-gsoc-progress-report/

A beta-version of the site is also available to the public:
http://paste.hskll.org
Please note that this is not a final product and you may experience
cryptic error messages, some downtime. The security is pretty tight
though :)

Any suggestions/comments are welcome.

[1] 
https://google-melange.appspot.com/gsoc/proposal/review/google/gsoc2013/difrumin/1

-- 
Sincerely yours,
-- Daniil Frumin

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


Re: [Haskell-cafe] Problems with GHC API and error handling

2013-06-16 Thread Daniel F
OK, thanks to Luite Stegeman I've found the solution and I think I'll
post it here in case someone else stumbles upon the same problem.

The solution is the following: you have to change 'log_action'
parameter in dynFlags. For example, one can do this:

---
initGhc = do
  ..
  ref - liftIO $ newIORef 
  dfs - getSessionDynFlags
  setSessionDynFlags $ dfs { hscTarget = HscInterpreted
   , ghcLink = LinkInMemory
   , log_action = logHandler ref}

logHandler :: IORef String - LogAction
logHandler ref dflags severity srcSpan style msg =
  case severity of
 SevError -   modifyIORef' ref (++ printDoc)
 SevFatal -   modifyIORef' ref (++ printDoc)
 _ - return ()
  where cntx = initSDocContext dflags style
 locMsg = mkLocMessage severity srcSpan msg
 printDoc = show (runSDoc locMsg cntx)

-- LogAction == DynFlags - Severity - SrcSpan - PprStyle - MsgDoc - IO ()

---
On Sat, Jun 15, 2013 at 1:26 PM, Daniel F difru...@gmail.com wrote:
 Hello, everyone.

 I am in need of setting up custom exception handlers when using GHC
 API to compile modules. Right now I have the following piece of code:

 * Main.hs:
 --
 import GHC
 import GHC.Paths
 import MonadUtils
 import Exception
 import Panic
 import Unsafe.Coerce
 import System.IO.Unsafe


 handleException :: (ExceptionMonad m, MonadIO m)
= m a - m (Either String a)
 handleException m =
   ghandle (\(ex :: SomeException) - return (Left (show ex))) $
   handleGhcException (\ge - return (Left (showGhcException ge ))) $
   flip gfinally (liftIO restoreHandlers) $
   m = return . Right


 initGhc :: Ghc ()
 initGhc = do
   dfs - getSessionDynFlags
   setSessionDynFlags $ dfs { hscTarget = HscInterpreted
, ghcLink = LinkInMemory }
   return ()

 test :: IO (Either String Int)
 test = handleException $ runGhc (Just libdir) $ do
   initGhc
   setTargets = sequence [ guessTarget ./test/file1.hs Nothing ]
   graph - depanal [] False
   loaded - load LoadAllTargets
   -- when (failed loaded) $ throw LoadingException
   setContext (map (IIModule . moduleName . ms_mod) graph)
   let expr = main
   ty - exprType expr -- throws exception if doesn't typecheck
   output ty
   res - unsafePerformIO . unsafeCoerce $ compileExpr expr
   return res

 --

 * file1.hs:

 
 module Main where

 main = do
   return x

 

 The problem is when I run the 'test' function above I receive the
 following output:

 h test

 test/file1.hs:4:10: Not in scope: `x'

 Left Cannot add module Main to context: not a home module
 it :: Either String Int


 So, if I understand this correctly, my exception handler does indeed
 catch an exception correctly,
 however, I still receive some output which I want to be captured.
 Is there a way to do this?

 --
 Sincerely yours,
 -- Daniil Frumin



-- 
Sincerely yours,
-- Daniil

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


[Haskell-cafe] Problems with GHC API and error handling

2013-06-15 Thread Daniel F
Hello, everyone.

I am in need of setting up custom exception handlers when using GHC
API to compile modules. Right now I have the following piece of code:

* Main.hs:
--
import GHC
import GHC.Paths
import MonadUtils
import Exception
import Panic
import Unsafe.Coerce
import System.IO.Unsafe


handleException :: (ExceptionMonad m, MonadIO m)
   = m a - m (Either String a)
handleException m =
  ghandle (\(ex :: SomeException) - return (Left (show ex))) $
  handleGhcException (\ge - return (Left (showGhcException ge ))) $
  flip gfinally (liftIO restoreHandlers) $
  m = return . Right


initGhc :: Ghc ()
initGhc = do
  dfs - getSessionDynFlags
  setSessionDynFlags $ dfs { hscTarget = HscInterpreted
   , ghcLink = LinkInMemory }
  return ()

test :: IO (Either String Int)
test = handleException $ runGhc (Just libdir) $ do
  initGhc
  setTargets = sequence [ guessTarget ./test/file1.hs Nothing ]
  graph - depanal [] False
  loaded - load LoadAllTargets
  -- when (failed loaded) $ throw LoadingException
  setContext (map (IIModule . moduleName . ms_mod) graph)
  let expr = main
  ty - exprType expr -- throws exception if doesn't typecheck
  output ty
  res - unsafePerformIO . unsafeCoerce $ compileExpr expr
  return res

--

* file1.hs:


module Main where

main = do
  return x



The problem is when I run the 'test' function above I receive the
following output:

h test

test/file1.hs:4:10: Not in scope: `x'

Left Cannot add module Main to context: not a home module
it :: Either String Int


So, if I understand this correctly, my exception handler does indeed
catch an exception correctly,
however, I still receive some output which I want to be captured.
Is there a way to do this?

-- 
Sincerely yours,
-- Daniil Frumin

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