Re: [Haskell-cafe] I Need a Better Functional Language!

2012-04-06 Thread Matthew Farkas-Dyck
On 05/04/2012, Grigory Sarnitskiy sargrig...@ya.ru wrote:
 One could expect from a language that bears 'functional' as its
 characteristic to be able to do everything imaginable with functions.
 However, the only thing Haskell can do with functions is to apply them to
 arguments and to feed them as arguments, run in parallel (run and
 concatenate programs).

 Obviously, that's not all of the imaginable possibilities. One also can
 rewrite programs. And write programs that rewrite programs. And write
 programs that rewrite programs that rewrite the first programs and so on.
 But there is no such possibility in Haskell, except for introducing a DSL.

 Note, that the reflectivity is important.

For x86 machine: http://hackage.haskell.org/package/hdis86

Truly, I often wish to be able to pattern match on functions myself.
Alas, the function is not an algebraic data type.

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


[Haskell-cafe] Records in Haskell: Type-Indexed Records (another proposal)

2012-03-03 Thread Matthew Farkas-Dyck
Hello all.

I wrote a new proposal for the Haskell record system. It can be found
at http://hackage.haskell.org/trac/ghc/wiki/Records/TypeIndexedRecords

Records are indexed by arbitrary Haskell types. Scope is controlled as
scope of key types. No fieldLabel declarations needed (as in DORF).

Cheers,
strake

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


Re: [Haskell-cafe] Rewrite this imperative in FP way

2012-02-05 Thread Matthew Farkas-Dyck
On Sun, Feb 5, 2012 at 2:28 PM, Haisheng Wu fre...@gmail.com wrote:
 for i in b:
   for j in c:
 if (i+j)3:
   d[i+j] += a[i]

 Do you have any cool solution in FP way?

Not sure whether this is cool, but here it is nonetheless:

a = repeat 1;
b = [0..3];
c = [0,2];
d = map (sum ∘ map ((a !!) ∘ fromIntegral) ∘ ($ (filter (3) ∘ map sum
∘ sequence) [b,c]) ∘ filter ∘ (≡)) [1..];

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


Re: [Haskell-cafe] Exceeding OS limits for simultaneous socket connections

2012-02-03 Thread Matthew Farkas-Dyck
Rob Stewart wrote:
 transmitting thousands of messages to each other, sometimes within a small 
 period of time.

Either SCTP or UDP seems far more appropriate than TCP (which I
assume, hopefully safely, to be at work here) for this task.

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


Re: [Haskell-cafe] implementing a text editor swap file

2012-01-17 Thread Matthew Farkas-Dyck
http://hackage.haskell.org/package/bytestring-mmap


On 17/01/2012, Martin DeMello martindeme...@gmail.com wrote:
 I'm writing a gtk2hs-based text editor, and would like to implement
 continuous (swap-file based) autosave the way vim and emacs do it. Any
 suggestions for how to implement this in a cross-platform manner?

 Also, is there a library that returns standard config file locations
 on a per-platform basis?

 martin

 ___
 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


Re: [Haskell-cafe] implementing a text editor swap file

2012-01-17 Thread Matthew Farkas-Dyck
On 17/01/2012, Erik de Castro Lopo mle...@mega-nerd.com wrote:
 Matthew Farkas-Dyck wrote:

 http://hackage.haskell.org/package/bytestring-mmap

 Since he's editing text, its a pity there isn't a text-mmap
 package :-).

Yeah, I had the same thought.

 Erik
 --
 --
 Erik de Castro Lopo
 http://www.mega-nerd.com/

 ___
 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] Monadic computation must now do IO, fails when type changed to IO.

2012-01-05 Thread Matthew Farkas-Dyck
Dear fellow Haskellers,

I have written an SMTP server (Main.hs at http://hpaste.org/56134,
full git repo at http://strake.zanity.net:1104/ymail.git), which
works, mostly – it responds to every message with that it was sent
properly, whether it was or not. (Try it: send an e-mail by SMTP to
this_is_not_a_u...@strake.zanity.net or somesuch.) The reason is, that
it simply tells the message (envelope, data) in a Writer monad, which
is later piped to the local delivery agent.

As I said, this works, but of course is suboptimal. I tried to change
the type of main_ to
(MonadState MTPState m, MonadIO m) = [Char] - m ([Char], [Char]),
just calling LDA in main_ (when mode is MTPTextMode) rather than
after, but then the program output nil.

I'm not sure what the problem is – I thought IO might not be lazy
enough so I tried a lazy wrapped-IO monad, in vain.

How, then, can this program call the LDA, wait to know whether it
worked or failed, and then respond?

Thanks for any help.

Cheers,
M Farkas-Dyck

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-21 Thread Matthew Farkas-Dyck
On 21/12/2011, Bas van Dijk v.dijk@gmail.com wrote:
 On 16 December 2011 16:26, Yves Parès limestr...@gmail.com wrote:
 1) What about the First type? Do we {-# DEPRECATE #-} it?

 Personnaly, I'm in favor of following the same logic than Int:
 Int itself is not a monoid. You have to be specific: it's either Sum or
 Mult.

 It should be the same for Maybe: we remove its instance of Monoid, and we
 only use First and Last.

 The reason you need to be specific with Int is that it's not clear
 which semantics (sum or product) you want. The semantics of Maybe are
 clear: it's failure-and-prioritized-choice.

 Changing the order of the arguments of mappend should be the job of Dual.

 If we really want to drop the Monoid instance for Maybe and keep First
 and Last and also want to be consistent we should also drop the Monoid
 instances of [a], a-b, Endo a and of all the tuples. And instead
 define Monoid instance for First [a], Last [a], First (a-b), Last
 (a-b), etc. I don't think this is what we want.

 Regards,

 Bas

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


Fair point. I concede.

If Monoid were necessarily inner-type-gnostic then we'd also have to
drop instance Monoid [a].

Cheers,
Matthew Farkas-Dyck

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


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

2011-12-20 Thread Matthew Farkas-Dyck
With GHC 7.0.3:

$ cat test.hs
class ℝ a where {
  test :: a;
};

(∈) :: Eq a = a - [a] - Bool;
x ∈ (y:ys) = x == y || x ∈ ys;

main = putStrLn Two of three ain't bad (^_~);
$ runhaskell test.hs
Two of three ain't bad (^_~)
$

On 20/12/2011, David Fox dds...@gmail.com wrote:
 On Mon, Dec 19, 2011 at 11:20 AM, Robert Clausecker fuz...@gmail.comwrote:

 Image you would create your own language with a paradigm similar to
 Haskell or have to chance to change Haskell without the need to keep any
 compatibility. What stuff would you add to your language, what stuff
 would you remove and what problems would you solve completely different?

 Thanks in advance for all answers, yours


 One thing that concerns me is the use of capital letters to distinguish
 type and class names and constructors from values.  If I was doing it over
 I would use a typographical distinction like italics for types, bold for
 classes.  That way we could have a constructor named ∅, a function named ∈,
 a class named ℝ.



Cheers,
Matthew Farkas-Dyck

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


Re: [Haskell-cafe] [Alternative] summary of my understanding so far

2011-12-17 Thread Matthew Farkas-Dyck
On 16/12/2011, Gregory Crosswhite gcrosswh...@gmail.com wrote:

 On Dec 17, 2011, at 12:35 PM, Matthew Farkas-Dyck wrote:

 (1) If we do (4), then the documentation ought to be adequate as-is.

 I see your point that if we do (4) then some and many are no longer
 problematic for Maybe and [], and thus we don't need warnings for those
 types.  However, nonetheless we will *still* need *big warnings* *for the
 sake of others who write Alternative instances* for new types to make sure
 that these instances do not fall into the same trap as Maybe and [].  That
 is, we want to let future authors of instances know about the conditions
 under which they will need to write their own versions of some and maybe in
 order to make sure that these methods have sensible behavior.

 Finally, if we adopt (4) then we will need to change the documentation to
 remove least from least solutions of the equations since the phrase will
 no longer be correct.  Better still, we could replace the phrase entirely
 with something like least *converging* solutions of the equations. (*)

Ah, true. Sorry.

 In addition to this, we also really need some additional documentation
 explaining what the point of some and many are, since few people have any
 clue about them.  :-)

Myself, I think it's quite clear by the axioms given, but I certainly
shan't grouch about more/better documentation.

 Cheers,
 Greg

 (*) P.S:

 Dear people who are better at this kind of technical language than I:

 I am fully aware of the fact that the phrase least converging solutions of
 the equations [...] is sloppy wording at best and absolutely wrong at
 worst, but hopefully you should at least understand what I am *trying* to
 get at.  Thus, I would welcome either your feedback on what it is that I am
 supposed to be thinking and saying, or an explanation about why the idea I
 am trying to conceive and convey is so intrinsically poorly formed that I am
 best off just giving up on it.  ;-)

Actually, now that I think of it, they are not, in general, the least
converging solutions -- in the case of a parser, for example, (some
(pure x)) would nevertheless diverge (I think).
Perhaps least sane solutions (^_^)

Cheers,
Matthew Farkas-Dyck

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-17 Thread Matthew Farkas-Dyck
On 17/12/2011, Gregory Crosswhite gcrosswh...@gmail.com wrote:

 On Dec 17, 2011, at 12:51 PM, Matthew Farkas-Dyck wrote:

 By my reason, the instance (Monoid a = Monoid (Maybe a)) is
 appropriate, since we have another class for inner-type-agnostic
 choice -- Alternative! (and MonadPlus, but that's essentially the
 same, and would be if (Functor m = Applicative m = Monad m), as it
 ought).

 Yes, but the problem here is that having different behavior for Alternative,
 MonadPlus, and Monoid instances is inherently confusing, in the sense that
 this would almost certainly surprise someone who wasn't already aware of the
 difference between the instances.

On 17/12/2011, Conor McBride co...@strictlypositive.org wrote:
 So your argument is to create incoherence because we can. I'm not
 convinced.

No, my argument is that Monoid and Alternative ought to have nonsame
semantics, since one is a class of types of kind (*), and the other,
(* - *). Thus, Monoid operations ought to mean the whole type, and
Alternative operations, just the outer type.

It shouldn't be a surprise -- it's impossible to put a constraint on
the inner type for an Alternative instance, since there is none (^_~)

  (Functor m = Applicative m = Monad m), as it ought.
 and as it already is in Strathclyde...

By default superclass instances, you mean? If so (and I understand
correctly), that's not quite the same; If I write, for (Applicative
FooBar - FooBar)
instance Monad FooBar where x = f = ...
then return would be undefined, despite pure (which ought to be in its
own class, anyhow (ō_ō)).

Cheers,
Matthew Farkas-Dyck

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


Re: [Haskell-cafe] [Alternative] summary of my understanding so far

2011-12-16 Thread Matthew Farkas-Dyck
On 15/12/2011, Gregory Crosswhite gcrosswh...@gmail.com wrote:
 1) Documentation really needs to be improved
 2) some/many cannot be physically separated from Alternative, but there
 *might* be an advantage to creating a subclass for them anyway purely for
 the sake of conveying more information about a type to users
 3) Maybe and [] are sensible instances of Alternative, even if many/some
 often enters an infinite loop.
 4) It is possible to provide special instance of many/some that satisfy the
 equations of many/some, with the slight disadvantage that these solutions
 are no longer the least solutions.

 Based on all of this, at this moment in time it seems to me that the most
 sensible way forward is to fix the documentation, tweak the definition of
 Alternative to no longer require the least solutions of the equations, and
 then to adopt the new instances for Maybe and [].

 Thoughts?

(1) If we do (4), then the documentation ought to be adequate as-is.
(2) In my opinion, no. If one is writing code polymorphic in
(Alternative f = f), then one needn't worry. If one is using such
code, then one ought to know whether some and many are sane for the
types in question, anyhow (O_ō)
(4) This is very reasonable; not the least solutions, but hey, they
converge (^_^)

 Cheers,
 Greg

Cheers,
Matthew Farkas-Dyck

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


Re: [Haskell-cafe] Alternative versus Monoid

2011-12-16 Thread Matthew Farkas-Dyck
On 15/12/2011, Conor McBride co...@strictlypositive.org wrote:

 On 15 Dec 2011, at 15:19, Brent Yorgey wrote:

 On Thu, Dec 15, 2011 at 06:49:13PM +1000, Gregory Crosswhite wrote:

 So at the end of the day... what is the point of even making Maybe
 and [] instances of Alternative?

 The Alternative and Monoid instances for [] are equivalent.  However,
 the Alternative and Monoid instances for Maybe are not. To wit:

 (Just (Sum  4)) | (Just (Sum 3))
  Just (Sum {getSum = 4})

 (Just (Sum 4)) `mappend` (Just (Sum 3))
  Just (Sum {getSum = 7})

 The current monoid instance for Maybe is, in my view, unfortunate.

 Types are about semantic purpose, not just data representation.
 Many purposes can be represented in the same way. We should identify
 the purpose of a type (or type constructor), then define instances
 consistent with that purpose. And better, we acquire by instance
 inference compound instances consistent with that purpose! (A similar
 view is often articulated well by Conal Elliott. But perhaps it's
 just a Con thing.)

 The purpose of Maybe, it seems to me, is to model failure and
 prioritized choice, after the manner of exceptions. It's clear
 what the failure-and-prioritized-choice monoid is.

 It so happens that the same data representation can be used to make
 a semigroup into a monoid by attaching an identity element. That's
 a different semantic purpose, which deserves a different type.

 This really bites. I really like being able to write things like

newtype P a x = P ([a] - Maybe (x, [a])) deriving Monoid

 and then make MonadPlus/Alternative instances just by copying the
 monoid that results, but it doesn't work!

 It's unfortunate that we don't have local quantification in
 constraints, so we can't write (forall x. Monoid (f x)), hence the
 need for constructor classes doing basically the same job, with,
 of necessity, newly renamed members. I think it compounds the
 problem to choose inconsistent behaviour between the constructor
 class and the underlying type class.

 Maybe I'm an extremist, but I'd prefer it if every Alternative
 instance was constructed by duplicating a polymorphic Monoid
 instance.

 Meanwhile, as for the issue which kicked this off, I do think it's
 good to document and enforce meaningful (i.e. total on total input)
 usages of operations by types where practical. At present, refining
 one type class into several to account for subtle issues (like
 whether some/many actually work) is expensive, even if it's
 desirable. I'd once again plug default superclass instances and
 Control.Newtype, then suggest that the library might benefit from a
 little pruning.

 All the best

 Conor

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


By my reason, the instance (Monoid a = Monoid (Maybe a)) is
appropriate, since we have another class for inner-type-agnostic
choice -- Alternative! (and MonadPlus, but that's essentially the
same, and would be if (Functor m = Applicative m = Monad m), as it
ought).

Cheers,
Matthew Farkas-Dyck

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


[Haskell-cafe] Cabal: Disjunctive Build-Depends

2011-12-12 Thread Matthew Farkas-Dyck
Hello all.

I have written some code that can be compiled with either of two
libraries, with no modification. How can I tell Cabal?

I tried || but it failed to parse.

I could find which package is available in the build script, and then
call defaultMainNoRead with the appropriate GenericPackageDescription,
but I'm not sure how to find this system-agnostically.

Thanks for any help.

Cheers,
Matthew Farkas-Dyck

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


Re: [Haskell-cafe] Cabal: Disjunctive Build-Depends

2011-12-12 Thread Matthew Farkas-Dyck
Grand. Thanks!


On 12/12/2011, Felipe Almeida Lessa felipe.le...@gmail.com wrote:
 On Mon, Dec 12, 2011 at 6:25 PM, Matthew Farkas-Dyck
 strake...@gmail.com wrote:
 I have written some code that can be compiled with either of two
 libraries, with no modification. How can I tell Cabal?

 I tried || but it failed to parse.

 I could find which package is available in the build script, and then
 call defaultMainNoRead with the appropriate GenericPackageDescription,
 but I'm not sure how to find this system-agnostically.

 You just need to use flags.  Something like

 Flag usethis
   Description:  Use this instead of that
   Default:  False

 Library
   Build-depends: ...everything else...
   if flag(usethis)
 Build-depends: this == 0.1.*
   else
 Build-depends: that == 4.0.*

 You don't need to care about usethis.  If 'that' is not installed but
 'this' is, Cabal will automatically turn 'usethis' flag on.

 Cheers,

 --
 Felipe.



-- 
Matthew Farkas-Dyck

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