Re: [Haskell-cafe] Adding type annotations to an AST?

2012-03-06 Thread Stephen Tetley
Hi Oleg - many thanks



On 6 March 2012 07:15,   wrote:
>
>> How do I add type annotations to interior locations in an abstract
>> syntax tree?
> {Snip}
>        Here is the solution
> http://okmij.org/ftp/Computation/FLOLAC/TEvalNR.hs
>
>        There is a bit of the explanation here:
> http://okmij.org/ftp/Computation/FLOLAC/lecture.pdf
>
>

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


Re: [Haskell-cafe] [Haskell] Higher types in contexts

2012-03-06 Thread Ryan Ingram
I find it easy to understand this distinction by writing out the types of
the constructors and case expressions for these objects, in a language like
system F:

(here, {x :: t} means a type argument with name x of kind t)

Exists :: {f :: *->*} -> {a :: *} -> f a -> Exists f
Forall :: {f :: *->*} -> ({a :: *} -> f a) -> Forall f

Notice the higher rank type in the constructor 'Forall'.

Similarly, the case deconstruction for these:

caseExists :: {r :: *} -> {f :: *->*} -> ({a :: *} -> f a -> r) -> Exists f
-> r
caseForall :: {r :: *} -> {f :: *->*} -> (({a :: *} -> f a) -> r) -> Forall
f -> r

The function passed to caseExists needs to be able to handle any type 'a'
we throw at it, whereas the function passed to caseForall can choose what
'a' it wants to use (and can choose multiple different 'a's by calling the
({a::*} -> f a) parameter function multiple times.  In the simple case that
the case function only instantiates 'a' at a single type, we can simplify
this:

caseForall' :: {r :: *} -> {f :: * -> *} -> {a :: *} -> (f a -> r) ->
Forall f -> r

and this function is definable in terms of caseForall:

caseForall' {r} {f} {a} k v = caseForall {r} {f} (\mk_fa -> k (mk_fa {a})) v

  -- ryan

On Mon, Mar 5, 2012 at 9:37 PM, wren ng thornton  wrote:

> On 3/5/12 5:13 PM, AntC wrote:
>
>> I've tried that ListFunc wrapping you suggest:
>> [...]
>>
>> But I can't 'dig out' the H-R function and apply it (not even
>> monomorphically):
>>
>
> That's because the suggestion changed it from a universal quantifier to an
> existential quantifier.
>
>data Exists f = forall a. Exists (f a)
>
>data Forall f = Forall (forall a. f a)
>
> With Exists, we're essentially storing a pair of the actual type 'a' and
> then the f a itself. We can't just pull out the f a and use it, because we
> don't know what 'a' is. We can bring it into scope temporarily by case
> matching on the Exists f, which allows us to use polymorphic functions, but
> we still don't actually know what it is so we can *only* use polymorphic
> functions.
>
> Conversely, with Forall we're storing some f a value which is in fact
> polymorphic in 'a'. Here, because it's polymorphic, the caller is free to
> choose what value of 'a' they would like the f a to use. Indeed, they can
> choose multiple different values of 'a' and get an f a for each of them.
>
> --
> Live well,
> ~wren
>
>
> __**_
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/**mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Alejandro Serrano Mena
Hi,
I'm really looking forward to helping in the Summer of Code, if Haskell
goes into it this year (something I take for granted :). I would like to
propose an idea for a project, and I'm looking for suggestions about
whether it's good, should be improved or it's just unfeasible.

My idea is to make a client-side Haskell Web Toolkit, in the spirit of
Google Web Toolkit, which would allow to program in Haskell the client part
of a web application, and would complement the web frameworks already
existing for Haskell (such as Yesod and Snap). The point is coming about
with a Haskell-ish way to program applications, to reuse all the existing
knowledge for our beloved language.

I've added more details in a pre-proposal in Google Docs, available in
https://docs.google.com/document/d/1FnTNO9uTobDHRTDXWurKns7vGTjeauw0nRhbtt6vavs/edit
Tell me if you prefer to see it in other format, but I didn't want to
generate a bigger e-mail.

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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Michael Snoyman
On Tue, Mar 6, 2012 at 11:40 PM, Alejandro Serrano Mena
 wrote:
> Hi,
> I'm really looking forward to helping in the Summer of Code, if Haskell goes
> into it this year (something I take for granted :). I would like to propose
> an idea for a project, and I'm looking for suggestions about whether it's
> good, should be improved or it's just unfeasible.
>
> My idea is to make a client-side Haskell Web Toolkit, in the spirit of
> Google Web Toolkit, which would allow to program in Haskell the client part
> of a web application, and would complement the web frameworks already
> existing for Haskell (such as Yesod and Snap). The point is coming about
> with a Haskell-ish way to program applications, to reuse all the existing
> knowledge for our beloved language.
>
> I've added more details in a pre-proposal in Google Docs, available
> in https://docs.google.com/document/d/1FnTNO9uTobDHRTDXWurKns7vGTjeauw0nRhbtt6vavs/edit
> Tell me if you prefer to see it in other format, but I didn't want to
> generate a bigger e-mail.
>
> Thanks in advance.

I definitely think the idea has merit. In general I'm wary of
solutions which try to compile down to Javascript[1], and I'm not sure
if actually providing a full Haskell-to-JS approach is a good idea.
Another possibility might be a DSL/combinator library for generating
JS. Though at this point, I wouldn't rule out either approach.

Yesod is currently wrapping up its 1.0 release (almost certainly
out-the-door by the end of April), and after that our main focus is
intended to be client-side integration, so we would certainly be happy
to discuss design ideas and collaborate in general.

Michael

[1] I say "compile down to" to mean nontrivial changes, as opposed to
something like Coffeescript, which is a fairly simple conversion.

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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Alejandro Serrano Mena
My idea would be reusing some of the already-available tools for compiling
Haskell to JS (for example, UHC), and develop with any of them a complete
library for client-side scripting; rather that redevelop a way to compile
Haskell to JS.

I think it's really a pity not being able to use things like what Yesod
provides in a client-side context. And both sides would benefit: they can
share common code for datatypes (as it's done in Google Web Toolkit), and
autogenerate some code for sending or receiving AJAX requests, for example.


2012/3/6 Michael Snoyman 

> On Tue, Mar 6, 2012 at 11:40 PM, Alejandro Serrano Mena
>  wrote:
> > Hi,
> > I'm really looking forward to helping in the Summer of Code, if Haskell
> goes
> > into it this year (something I take for granted :). I would like to
> propose
> > an idea for a project, and I'm looking for suggestions about whether it's
> > good, should be improved or it's just unfeasible.
> >
> > My idea is to make a client-side Haskell Web Toolkit, in the spirit of
> > Google Web Toolkit, which would allow to program in Haskell the client
> part
> > of a web application, and would complement the web frameworks already
> > existing for Haskell (such as Yesod and Snap). The point is coming about
> > with a Haskell-ish way to program applications, to reuse all the existing
> > knowledge for our beloved language.
> >
> > I've added more details in a pre-proposal in Google Docs, available
> > in
> https://docs.google.com/document/d/1FnTNO9uTobDHRTDXWurKns7vGTjeauw0nRhbtt6vavs/edit
> > Tell me if you prefer to see it in other format, but I didn't want to
> > generate a bigger e-mail.
> >
> > Thanks in advance.
>
> I definitely think the idea has merit. In general I'm wary of
> solutions which try to compile down to Javascript[1], and I'm not sure
> if actually providing a full Haskell-to-JS approach is a good idea.
> Another possibility might be a DSL/combinator library for generating
> JS. Though at this point, I wouldn't rule out either approach.
>
> Yesod is currently wrapping up its 1.0 release (almost certainly
> out-the-door by the end of April), and after that our main focus is
> intended to be client-side integration, so we would certainly be happy
> to discuss design ideas and collaborate in general.
>
> Michael
>
> [1] I say "compile down to" to mean nontrivial changes, as opposed to
> something like Coffeescript, which is a fairly simple conversion.
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Chris Smith
My first impression on this is that it seems a little vague, but
possibly promising.

I'd make it clearer that you plan to contribute to the existing UHC
stuff.  A first glance left me with the impression that you wanted to
re-implement a JavaScript back end, which would of course be a
non-starter as a GSoC project.  Since the actual proposal is to work
on the build system and libraries surrounding the existing UHC back
end, I'd maybe suggest revising the proposal to be clearer about that,
and more specific about what parts of the current UHC compiler, build
system, and libraries you propose working on.

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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Michael Snoyman
My issue isn't that you'd need to develop a new set of tools. I just
think that using a library approach would allow us to generate more
comprehensible code. Hopefully, we could still reuse datatypes, and do
lots of other fun stuff. For example, if we used aeson's
ToJSON/FromJSON instances for serialization, and some kind of lens
library in place of normal record selectors, there's no reason why
would couldn't automatically convert:

personName person

to

person.name

I know I'm saying a lot of vague stuff here, simply because I haven't
had a chance to really solidify my ideas on how to move forward on it.
But I'm certainly not ruling out any possibilities at this point,
simply stating a preference to avoid a full-blown Haskell-to-JS
solution.

Michael

On Wed, Mar 7, 2012 at 12:10 AM, Alejandro Serrano Mena
 wrote:
> My idea would be reusing some of the already-available tools for compiling
> Haskell to JS (for example, UHC), and develop with any of them a complete
> library for client-side scripting; rather that redevelop a way to compile
> Haskell to JS.
>
> I think it's really a pity not being able to use things like what Yesod
> provides in a client-side context. And both sides would benefit: they can
> share common code for datatypes (as it's done in Google Web Toolkit), and
> autogenerate some code for sending or receiving AJAX requests, for example.
>
>
> 2012/3/6 Michael Snoyman 
>>
>> On Tue, Mar 6, 2012 at 11:40 PM, Alejandro Serrano Mena
>>  wrote:
>> > Hi,
>> > I'm really looking forward to helping in the Summer of Code, if Haskell
>> > goes
>> > into it this year (something I take for granted :). I would like to
>> > propose
>> > an idea for a project, and I'm looking for suggestions about whether
>> > it's
>> > good, should be improved or it's just unfeasible.
>> >
>> > My idea is to make a client-side Haskell Web Toolkit, in the spirit of
>> > Google Web Toolkit, which would allow to program in Haskell the client
>> > part
>> > of a web application, and would complement the web frameworks already
>> > existing for Haskell (such as Yesod and Snap). The point is coming about
>> > with a Haskell-ish way to program applications, to reuse all the
>> > existing
>> > knowledge for our beloved language.
>> >
>> > I've added more details in a pre-proposal in Google Docs, available
>> >
>> > in https://docs.google.com/document/d/1FnTNO9uTobDHRTDXWurKns7vGTjeauw0nRhbtt6vavs/edit
>> > Tell me if you prefer to see it in other format, but I didn't want to
>> > generate a bigger e-mail.
>> >
>> > Thanks in advance.
>>
>> I definitely think the idea has merit. In general I'm wary of
>> solutions which try to compile down to Javascript[1], and I'm not sure
>> if actually providing a full Haskell-to-JS approach is a good idea.
>> Another possibility might be a DSL/combinator library for generating
>> JS. Though at this point, I wouldn't rule out either approach.
>>
>> Yesod is currently wrapping up its 1.0 release (almost certainly
>> out-the-door by the end of April), and after that our main focus is
>> intended to be client-side integration, so we would certainly be happy
>> to discuss design ideas and collaborate in general.
>>
>> Michael
>>
>> [1] I say "compile down to" to mean nontrivial changes, as opposed to
>> something like Coffeescript, which is a fairly simple conversion.
>
>

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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Christopher Done
I might as well chime in on this thread as it is relevant to my
interests. I made a write up on a comparison of HJScript (JavaScript
EDSL) and my Ji (control browser from Haskell) library:
https://github.com/chrisdone/ji

HJScript is "OK", hpaste.org uses it here:
https://github.com/chrisdone/amelie/blob/master/src/Amelie/View/Script.hs
output here: http://hpaste.org/js/amelie.js

Mini-summary of my experience: You're still stuck with JS semantics,
and it can be a little odd when you confuse what level of code (JS or
HS) you're working at, but at least it works right now and can be
well-typed. The library needs a bit of an overhaul, the GADT of
HJavaScript is simply flawed (take a brief look and you can see it can
express totally invalid JS in the syntax tree and the pretty printer
breaks operator/parens), but HJScript sorts the latter out, and I
would make all HJScript's functions generic upon MonadJS or something,
if you want a reader transformer or whatnot (i.e. to carry around some
state, a JS "object"), it breaks down with any higher-order
combinators taking actions as arguments. I also had some problems
making things generic AND type-accurate, but I don't recall them well
enough now. Problems aside, At Least It's Partially Well Typed.

I tried UHC out recently, made a little API for the canvas tag and
drew some pretty things. Had a little trouble with timers, though… the
callback for the timer /worked/, but the alert[1] printed the same
thing every time, as if the thunk forcing is somehow broken. I looked
at the outputted code but couldn't quite grok what was wrong with it.
Didn't get more time to investigate why. It may just be my code but it
looks sound to me, though I'm mostly winging it with the HTML5 part.

Anyway, look forward to watching ideas and work in this area.

Ciao!

[1]:

module Main where

import Control.Monad
import Language.UHC.JScript.Assorted
import Language.UHC.JScript.W3C.HTML5
import Language.UHC.JScript.ECMA.String
import Language.UHC.JScript.ECMA.Date
import Language.UHC.JScript.Types
import Language.UHC.JScript.Primitives
import Data.IORef

main = do
  doc <- document
  bodies <- documentGetElementsByTagName doc (toJS "canvas")
  body <- nodeListItem bodies 0
  ctx <- getContext body "2d"
  setFillStyle ctx "rgb(200,0,0)"
  start <- newIORef 0
  setInterval 1000 $ do
st <- readIORef start
forM_ [st..st+30] $ \i -> do
  let ir = fromIntegral i
  fillRect ctx (20 + 10*round (sin ir)) (i*10) 2 2
writeIORef start (st + 1)
alert (show st)
  return ()

In HTML5.hs:

data Timer

foreign import jscript "setInterval(%*)"
  _setInterval :: FunPtr (IO ()) -> Int -> IO Timer

foreign import jscript "wrapper"
  makeIntervalCallback :: IO () -> IO (FunPtr (IO ()))

setInterval delay haskellCallback = do
  jsCallback <- makeIntervalCallback haskellCallback
  _setInterval jsCallback delay

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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Bardur Arantsson

On 03/06/2012 11:38 PM, Christopher Done wrote:

I might as well chime in on this thread as it is relevant to my
interests. I made a write up on a comparison of HJScript (JavaScript
EDSL) and my Ji (control browser from Haskell) library:
https://github.com/chrisdone/ji

HJScript is "OK", hpaste.org uses it here:
https://github.com/chrisdone/amelie/blob/master/src/Amelie/View/Script.hs
output here: http://hpaste.org/js/amelie.js



HJScript (0.5.0) generates invalid Javascript if you try to use 
anonymous functions.


(Digs through email archives... Ah, yes:)

 snip 
Given

> testJS :: HJScript ()
> testJS = do
>   f <- function (\(e :: JInt) -> do
> x <- inVar true
> return $ x)
>   callProc f (int 3)
>   return ()
>
> main :: IO ()
> main = do
>   putStrLn $ "JS: " ++ (show $ evalHJScript $ testJS)

We get the output

> function (param0_0){var var_1 = true;return var_1;}(3);

But this is invalid syntax in JavaScript, and should really be

> (function (param0_0){var var_1 = true;return var_1;})(3);

... which works.

 snip 

Just something to be aware of.

(For my particular usage it was also too strictly typed, but that's 
another matter.)


Regards,


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


Re: [Haskell-cafe] Summer of Code idea: Haskell Web Toolkit

2012-03-06 Thread Christopher Done
On 7 March 2012 06:14, Bardur Arantsson  wrote:
> We get the output
>
>> function (param0_0){var var_1 = true;return var_1;}(3);
>
> But this is invalid syntax in JavaScript, and should really be
>
>> (function (param0_0){var var_1 = true;return var_1;})(3);

Right, that's one of the ones I picked up in HJavascript. Didn't
realise (or remember) it was present in HJScript, supposing that it
had its own pretty printer. Other stuff like this is present in the
HJavascript GADT.

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