[Haskell-cafe] Do people use visitor pattern in Haskell...

Alexander Solla alex.solla at gmail.com
Fri Jun 19 16:46:01 UTC 2015


> If all you can do with WibblePackage is recover either a Foo or a Bar,
why not just use Either Foo Bar?

Typically, I just go straight for "data types a la carte" when I need any
kind of type-level disjunction.  Define the type synonym:

type (:+:) a b = Either a b

and define a type class

class (:<:) a b where
  inj :: a -> b

with some appropriate instances (as specified in the paper)[1], and you can
chain disjunctions almost automatically:

data Commercial = Commercial
data Retail = Retail
data Investment = Investment

type Bank = Retail :+: Commercial :+: Investment

bac :: Bank
bac = inj $ Retail

[1]: http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf


On Fri, Jun 19, 2015 at 9:10 AM, Patrick Chilton <chpatrick at gmail.com>
wrote:

> This is a frequent antipattern:
> https://lukepalmer.wordpress.com/2010/01/24/haskell-antipattern-existential-typeclass/
>
> If all you can do with WibblePackage is recover either a Foo or a Bar, why
> not just use Either Foo Bar?
>
> On Fri, Jun 19, 2015 at 5:09 PM, Nicholls, Mark <nicholls.mark at vimn.com>
> wrote:
>
>>  The design pattern is very well known in the OO community…most of the
>> use cases evaporate in Haskell….in some sense its part of the language…
>>
>>
>>
>> Haskell is my 9th or 10th language, I can barely write “hello world”
>> without the manual, so I’m still at times I’m still trying to discover the
>> basic idioms…
>>
>>
>>
>> How to put heterogenuos things in a list…and yet not loose all type
>> information (I know about HList…but I think that’s for special occasions)
>>
>>
>>
>>
>>
>> *From:* Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] *On
>> Behalf Of *Anupam Jain
>> *Sent:* 19 June 2015 5:04 PM
>> *To:* haskell-cafe Cafe
>> *Subject:* Re: [Haskell-cafe] Do people use visitor pattern in Haskell...
>>
>>
>>
>> I discovered the same general pattern foroop
>>
>> On Friday, June 19, 2015, Nicholls, Mark <nicholls.mark at vimn.com> wrote:
>>
>> My initial guess would be no…its built into the language
>>
>>
>>
>> But….
>>
>>
>>
>> I find myself tempted to use it (in order to match on a type that’s the
>> instance of a typeclass)…which makes me think I’ve missed something.
>>
>>
>>
>> So…
>>
>>
>>
>> > data Foo = Foo
>>
>> > data Bar = Bar
>>
>>
>>
>> Ooo…this looks like an OO design pattern…surely wrong?
>>
>>
>>
>> > class Wibble a where
>>
>> >   visit :: (Foo -> b) -> (Bar -> b) -> a -> b
>>
>>
>>
>> > instance Wibble Foo where
>>
>> >   visit f _ x = f x
>>
>> > instance Wibble Bar where
>>
>> >   visit _ f x = f x
>>
>>
>>
>> I want a list of Wibbles....
>>
>> hmmm...
>>
>> (Wibble a) => [a] is clearly wrong...
>>
>> I want [(Wibble a) =>a]
>>
>>
>>
>> so I package it up?
>>
>>
>>
>> > data WibblePackage where
>>
>> >   WibblePackage :: (Wibble a) => a -> WibblePackage
>>
>>
>>
>> lets try this now…so pointless function across Wibbles in a list.
>>
>>
>>
>> > fizzBuzz :: [WibblePackage] -> Integer
>>
>> > fizzBuzz []       = 0
>>
>> > fizzBuzz ((WibblePackage x) : xs) = (visit (\_ -> 1) (\_ -> 2) x) +
>> (fizzBuzz xs)
>>
>>
>>
>> > help :: Integer
>>
>> > help = fizzBuzz [WibblePackage Foo,WibblePackage Bar]
>>
>>
>>
>>
>>
>> That works!
>>
>>
>>
>> OO nerds will get uptight about “closing” the Wibble typeclass….but I’ve
>> managed to create a list of different types and have a mechanism for
>> recovering the type.
>>
>>
>>
>> How would a Haskell nerd do this? (I have looked, but they look more
>> complicated….maybe to my OO eye).
>>
>>
>>
>>
>>
>>
>>
>> CONFIDENTIALITY NOTICE
>>
>> This e-mail (and any attached files) is confidential and protected by
>> copyright (and other intellectual property rights). If you are not the
>> intended recipient please e-mail the sender and then delete the email and
>> any attached files immediately. Any further use or dissemination is
>> prohibited.
>>
>> While MTV Networks Europe has taken steps to ensure that this email and
>> any attachments are virus free, it is your responsibility to ensure that
>> this message and any attachments are virus free and do not affect your
>> systems / data.
>>
>> Communicating by email is not 100% secure and carries risks such as
>> delay, data corruption, non-delivery, wrongful interception and
>> unauthorised amendment. If you communicate with us by e-mail, you
>> acknowledge and assume these risks, and you agree to take appropriate
>> measures to minimise these risks when e-mailing us.
>>
>> MTV Networks International, MTV Networks UK & Ireland, Greenhouse,
>> Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions
>> International, Be Viacom, Viacom International Media Networks and VIMN and
>> Comedy Central are all trading names of MTV Networks Europe.  MTV Networks
>> Europe is a partnership between MTV Networks Europe Inc. and Viacom
>> Networks Europe Inc.  Address for service in Great Britain is 17-29 Hawley
>> Crescent, London, NW1 8TT.
>>
>>
>>
>> --
>> Sent from my hyper-communicator
>>
>>
>>
>> CONFIDENTIALITY NOTICE
>>
>> This e-mail (and any attached files) is confidential and protected by
>> copyright (and other intellectual property rights). If you are not the
>> intended recipient please e-mail the sender and then delete the email and
>> any attached files immediately. Any further use or dissemination is
>> prohibited.
>>
>> While MTV Networks Europe has taken steps to ensure that this email and
>> any attachments are virus free, it is your responsibility to ensure that
>> this message and any attachments are virus free and do not affect your
>> systems / data.
>>
>> Communicating by email is not 100% secure and carries risks such as
>> delay, data corruption, non-delivery, wrongful interception and
>> unauthorised amendment. If you communicate with us by e-mail, you
>> acknowledge and assume these risks, and you agree to take appropriate
>> measures to minimise these risks when e-mailing us.
>>
>> MTV Networks International, MTV Networks UK & Ireland, Greenhouse,
>> Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions
>> International, Be Viacom, Viacom International Media Networks and VIMN and
>> Comedy Central are all trading names of MTV Networks Europe.  MTV Networks
>> Europe is a partnership between MTV Networks Europe Inc. and Viacom
>> Networks Europe Inc.  Address for service in Great Britain is 17-29 Hawley
>> Crescent, London, NW1 8TT.
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20150619/e97fe250/attachment.html>


More information about the Haskell-Cafe mailing list