From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 1 16:59:39 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 1 Oct 2018 16:59:39 +0000 Subject: [Haskell-beginners] optimisation of code In-Reply-To: References: , Message-ID: > Hi, > Current code re-checks file existence always in same order, so worst case is - N files and only last of them does not exists. > In that case this code will re-check (N-1) files during each consecutive retry. > This can be optimized by moving already existing files to the end of file list(or dropping them from list completely, if files are only > > added but never removed). > For this you could re-write `allFilesThere` something like: > allFilesThere fs = liftIO $ do > existing, non_existing <- partitionM (doesFileExist . fromAbsFile) fs < return (non_existing++ existing, null non_existing) > Then allFilesThere could start next iteration by checking previously non-existing files and probably failing much faster. thanks a lot, files are never removed, so I can forget already checked files :) From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 1 17:01:48 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 1 Oct 2018 17:01:48 +0000 Subject: [Haskell-beginners] optimisation of code In-Reply-To: References: , Message-ID: > My first instinct is to just use anyM instead of allM > allFilesThere :: MonadIO m => [Path Abs File] -> m Bool > allFilesThere fs = liftIO $ anyM (not . doesFileExist . fromAbsFile) fs > However you'll now have the opposite problem. It will take a lot of resources when all the files are there. But maybe that is okay for your use case? I need to reduce the worload when a file is missing. I like a lot the partition idea. Cheers Frederic From frederic-emmanuel.picca at synchrotron-soleil.fr Tue Oct 2 16:48:09 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Tue, 2 Oct 2018 16:48:09 +0000 Subject: [Haskell-beginners] Tagged types Message-ID: Hello suppose that I have a bunch of type like this data Unchecked data Hdf5 data Cbf data A t > A String The A thing come from a database as A Unchecked now if I read the String and it ends with .h5, I have a A Hdf5 type and If the string end with .cbf, I have a A Cbf. So I would like a function which allow to return a A Hdf5 or a A Cbf depending on the String content. check :: A Unchecked -> A ??? check = ??? Is it possible to do this ? Thanks Frederic PS: At the end I will have more tha one tag. From fa-ml at ariis.it Tue Oct 2 16:56:48 2018 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 2 Oct 2018 18:56:48 +0200 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: Message-ID: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> Hello Frederic, On Tue, Oct 02, 2018 at 04:48:09PM +0000, PICCA Frederic-Emmanuel wrote: > So I would like a function which allow to return a A Hdf5 or a A Cbf depending on the String content. > > check :: A Unchecked -> A ??? > check = ??? > > Is it possible to do this ? I believe you can do this with GADTs [1] [1] https://en.wikibooks.org/wiki/Haskell/GADT From frederic-emmanuel.picca at synchrotron-soleil.fr Tue Oct 2 17:04:42 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Tue, 2 Oct 2018 17:04:42 +0000 Subject: [Haskell-beginners] Tagged types In-Reply-To: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> References: , <20181002165648.tzmyistn2uwiwmbo@x60s.casa> Message-ID: > I believe you can do this with GADTs [1] I can create different constructors for the different types. but how can I create a function which return different type ? Fred From leiva.steven at gmail.com Tue Oct 2 17:18:14 2018 From: leiva.steven at gmail.com (Steven Leiva) Date: Tue, 2 Oct 2018 12:18:14 -0500 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> Message-ID: Unfortunately I do not know the fancy Haskell type-level stuff, but if I was looking at this same problem, I'd think you need a sum type: data Unchecked = Unchecked String data Checked = Hd5 String | Cbf String check :: Unchecked -> Checked There is likely a better concept than "Checked" in your domain. I do not know what those things represent, but I would use that *ubiquitous language* instead - i.e., data Image ... instead of Checked. On Tue, Oct 2, 2018 at 12:05 PM PICCA Frederic-Emmanuel < frederic-emmanuel.picca at synchrotron-soleil.fr> wrote: > > I believe you can do this with GADTs [1] > > I can create different constructors for the different types. > but how can I create a function which return different type ? > > > Fred > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Steven Leiva 305.528.6038 leiva.steven at gmail.com http://www.linkedin.com/in/stevenleiva -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Tue Oct 2 17:27:20 2018 From: toad3k at gmail.com (David McBride) Date: Tue, 2 Oct 2018 13:27:20 -0400 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> Message-ID: You need to have some sort of either type. check :: A Unchecked -> Either (A Hdf5) (A Cbf) But you'll have to deal with the fact that it could be either of those things throughout the rest of your program, somehow. Another way would be to have data CheckedType = Hdf5 | Cbf check :: A Unchecked -> A CheckedType But this has the same downside. There may be some way with the singletons library, but I think that is out of the scope of the newbies list. On Tue, Oct 2, 2018 at 1:04 PM PICCA Frederic-Emmanuel < frederic-emmanuel.picca at synchrotron-soleil.fr> wrote: > > I believe you can do this with GADTs [1] > > I can create different constructors for the different types. > but how can I create a function which return different type ? > > > Fred > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Wed Oct 3 12:21:35 2018 From: fa-ml at ariis.it (Francesco Ariis) Date: Wed, 3 Oct 2018 14:21:35 +0200 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> Message-ID: <20181003122135.wf2lryw4zjxl67v5@x60s.casa> On Tue, Oct 02, 2018 at 05:04:42PM +0000, PICCA Frederic-Emmanuel wrote: > > I believe you can do this with GADTs [1] > > I can create different constructors for the different types. > but how can I create a function which return different type ? Mhhh I tried to come up with an example (GADTs, ExistentialQuantification, etc.) and failed... This is an interesting problem and one that could interest many people; please post your question on -cafe too (with a minimal .hs, it always helps); I am curious on how they will approach the problem -F From kitttoran at gmail.com Wed Oct 3 23:50:09 2018 From: kitttoran at gmail.com (=?UTF-8?B?0J3QuNC60LjRgtCwINCk0YPRhNCw0LXQsg==?=) Date: Thu, 4 Oct 2018 02:50:09 +0300 Subject: [Haskell-beginners] Tagged types In-Reply-To: <20181003122135.wf2lryw4zjxl67v5@x60s.casa> References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> Message-ID: As this problem requires type to depend on runtime value, you need singletons. data Format = Hdf5 | Cbf data SFormat a where -- this is called a singleton type SHdf5 :: SFormat Hdf5 SCbf :: SFormat Cbf data A (t::Format) = A String data SomeA where SomeA :: SFormat f -> A f -> SomeA check :: String -> SomeA check "foo" = SomeA SHdf5 (A "foo") check "bar" = SomeA SCbf (A "bar") you can recover the type of A be pattern-matching: someFunc :: SomeA -> A Hdf5 someFunc (SomeA SHdf5 a) = a -- a has type A Hdf5 here, equation typechecks someFunc (SomeA SCbf a) = a -- a has type A SCbf here, this is a type error You will need KindSignatures, DataKinds and GADTs language extensions. With some effort you can probably add Unchecked type tag to the picture if you don't want to use just Strings for A Unchecked. One downside of this method is that you need to enumerate all the possible tags twice. There is a singletons package [1] that can automatically generate SFormat for you. [1] http://hackage.haskell.org/package/singletons On 03/10/2018, Francesco Ariis wrote: > On Tue, Oct 02, 2018 at 05:04:42PM +0000, PICCA Frederic-Emmanuel wrote: >> > I believe you can do this with GADTs [1] >> >> I can create different constructors for the different types. >> but how can I create a function which return different type ? > > Mhhh I tried to come up with an example (GADTs, ExistentialQuantification, > etc.) and failed... > > This is an interesting problem and one that could interest many people; > please post your question on -cafe too (with a minimal .hs, it always > helps); I am curious on how they will approach the problem > > -F > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Никита Фуфаев, +7 999 825-95-07 From fa-ml at ariis.it Thu Oct 4 13:10:34 2018 From: fa-ml at ariis.it (Francesco Ariis) Date: Thu, 4 Oct 2018 15:10:34 +0200 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> Message-ID: <20181004131034.dcb63i4srjy7cypm@x60s.casa> Hello Nikita, On Thu, Oct 04, 2018 at 02:50:09AM +0300, Никита Фуфаев wrote: > As this problem requires type to depend on runtime value, > you need singletons. Many thanks for showing us the way, very elegant solution. From mukeshtiwari.iiitm at gmail.com Sat Oct 6 12:49:36 2018 From: mukeshtiwari.iiitm at gmail.com (mukesh tiwari) Date: Sat, 6 Oct 2018 22:49:36 +1000 Subject: [Haskell-beginners] Tagged types In-Reply-To: <20181004131034.dcb63i4srjy7cypm@x60s.casa> References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa> Message-ID: Hi Everyone, I tried to come up with a solution, but it has plenty of drawbacks. data Tag = Hdf5 | Cbf | Unchecked data A :: Tag -> Type where Ca :: Symbol -> A Unchecked Ch :: A Hdf5 Cb :: A Cbf type family Typestring (a :: A Unchecked) :: Type type instance Typestring (Ca "hdf5") = A Hdf5 type instance Typestring (Ca "cbf") = A Cbf data SUnchecked a where Sh :: SUnchecked (Ca "hdf5") Sc :: SUnchecked (Ca "cbf") This checkValue function is useless, because you need to pass A Unchecked, and constructor (Ca) takes Symbol rather than String, and value of type SUnchecked a. checkValue :: forall (a :: A Unchecked). A Unchecked -> SUnchecked a -> Typestring a checkValue (Ca x) Sh = Ch checkValue (Ca x) Sc = Cb When I tried to run the above code *Main> :t checkValue (Ca (someSymbolVal "hdf5")) :1:17: error: • Couldn't match expected type ‘Symbol’ with actual type ‘GHC.TypeLits.SomeSymbol’ • In the first argument of ‘Ca’, namely ‘(someSymbolVal "hdf5")’ In the first argument of ‘checkValue’, namely ‘(Ca (someSymbolVal "hdf5"))’ In the expression: checkValue (Ca (someSymbolVal "hdf5")) What I really want is something like this, but the problem is I can't do pattern matching on symbols, and if I change the data type to String from Symbol then it won't compile . Could some one point me how to solve this problem? checkValue :: forall (a :: A Unchecked). SUnchecked a => A Unchecked -> Typestring a checkValue (Ca "hdf5") = Ch checkValue (Ca "cbf") = Cb Best regards, Mukesh On Thu, Oct 4, 2018 at 11:11 PM Francesco Ariis wrote: > Hello Nikita, > > On Thu, Oct 04, 2018 at 02:50:09AM +0300, Никита Фуфаев wrote: > > As this problem requires type to depend on runtime value, > > you need singletons. > > Many thanks for showing us the way, very elegant solution. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mihai.maruseac at gmail.com Sat Oct 6 16:18:06 2018 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Sat, 6 Oct 2018 09:18:06 -0700 Subject: [Haskell-beginners] [Call for Contributions] Haskell Communities and Activities Report, November 2018 edition (35th edition) Message-ID: Dear all, We would like to collect contributions for the 35th edition of the ============================================================ Haskell Communities & Activities Report http://www.haskell.org/haskellwiki/Haskell_Communities_and_Activities_Report Submission deadline: 4 November 2018 (please send your contributions to hcar at haskell.org, in plain text or LaTeX format, both are equally accepted) ============================================================ This is the short story: * If you are working on any project that is in some way related to Haskell, please write a short entry and submit it. Even if the project is very small or unfinished or you think it is not important enough --- please reconsider and submit an entry anyway! * If you are interested in an existing project related to Haskell that has not previously been mentioned in the HCAR, please tell us, so that we can contact the project leaders and ask them to submit an entry. * If you are working on a project that is looking for contributors, please write a short entry and submit it, mentioning that your are looking for contributors. * Feel free to pass on this call for contributions to others that might be interested. More detailed information: The Haskell Communities & Activities Report is a bi-annual overview of the state of Haskell as well as Haskell-related projects over the last, and possibly the upcoming six months. If you have only recently been exposed to Haskell, it might be a good idea to browse the previous edition --- you will find interesting projects described as well as several starting points and links that may provide answers to many questions. Contributions will be collected until the submission deadline. They will then be compiled into a coherent report that is published online as soon as it is ready. As always, this is a great opportunity to update your webpages, make new releases, announce or even start new projects, or to talk about developments you want every Haskeller to know about! Looking forward to your contributions, Mihai Maruseac FAQ: Q: What format should I write in? A: Any format is ok, I will transpose the submission to the format in use at the time of publication. Previous editions have used a LaTeX format, with the template that is available at: http://haskell.org/communities/11-2018/template.tex And the associated LaTeX style file at http://haskell.org/communities/11-2018/hcar.sty You can use those to edit and preview your entry, but it is very likely that by the time of publication the entire HCAR pipeline would be changed to a more modern one. You will receive a copy of the draft, prior to publication, to ensure that everything looks ok. If you modify an old entry that you have written for an earlier edition of the report, you should soon receive your old entry as a template (provided we have your valid email address). Please modify that template, rather than using your own version of the old entry as a template. Q: Can I include Haskell code? A: Yes. If using LaTeX, you can use lhs2tex syntax (http://www.andres-loeh.de/lhs2tex/). The report is compiled in mode polycode.fmt. Q: Can I include images? A: Yes, you are even encouraged to do so. Please use .jpg or .png format, then. PNG is preferred for simplicity. Q: Should I send files in .zip archives or similar? A: No, plain file attachments are the way. Q: How much should I write? A: Authors are asked to limit entries to about one column of text. A general introduction is helpful. Apart from that, you should focus on recent or upcoming developments. Pointers to online content can be given for more comprehensive or "historic" overviews of a project. Images do not count towards the length limit, so you may want to use this opportunity to pep up entries. There is no minimum length of an entry! The report aims for being as complete as possible, so please consider writing an entry, even if it is only a few lines long. Q: Which topics are relevant? A: All topics which are related to Haskell in some way are relevant. We usually had reports from users of Haskell (private, academic, or commercial), from authors or contributors to projects related to Haskell, from people working on the Haskell language, libraries, on language extensions or variants. We also like reports about distributions of Haskell software, Haskell infrastructure, books and tutorials on Haskell. Reports on past and upcoming events related to Haskell are also relevant. Finally, there might be new topics we do not even think about. As a rule of thumb: if in doubt, then it probably is relevant and has a place in the HCAR. You can also simply ask us. Q: Is unfinished work relevant? Are ideas for projects relevant? A: Yes! You can use the HCAR to talk about projects you are currently working on. You can use it to look for other developers that might help you. You can use HCAR to ask for more contributors to your project, it is a good way to gain visibility and traction. Q: If I do not update my entry, but want to keep it in the report, what should I do? A: Tell us that there are no changes. The old entry will typically be reused in this case, but it might be dropped if it is older than a year, to give more room and more attention to projects that change a lot. Do not resend complete entries if you have not changed them. Q: Will I get confirmation if I send an entry? How do I know whether my email has even reached its destination, and not ended up in a spam folder? A: Prior to publication of the final report, we will send a draft to all contributors, for possible corrections. So if you do not hear from us within two weeks after the deadline, it is safer to send another mail and check whether your first one was received. -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From dennis.raddle at gmail.com Tue Oct 9 08:45:18 2018 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 9 Oct 2018 01:45:18 -0700 Subject: [Haskell-beginners] why is ScopedTypeVariables not fixing this error? Message-ID: In the following snippet from a program in progress (designed to compute percentile rank for arbitrary lists of values) , I was hoping to declare types of functions within the main function just as a way of helping myself catch type errors. I'm getting the error "Can't match 'a' with 'a1'.... where 'a' is rigid type variable... etc. etc." on the line indicated in the comment below. The usual error I get when I try to do this without ScopedTypeVariables. So, I thought that ScopedTypeVariables was supposed to allow this kind of usage. What am I doing wrong? {-# LANGUAGE ScopedTypeVariables #-} import qualified Data.Map as M import qualified Data.List as L import Data.Map(Map) import Data.Function -- data PercentileData = PercentileData Double Double -- new attempt, October 2018: using new PercentileData construct to -- represent percentile in both ways. (at/below, or below) computePercentile :: Ord a => Map a Double -> Map a PercentileData computePercentile dataIn = error "foo" where pairs :: [(a,Double)] -- THIS IS THE LINE GETTING THE ERROR pairs = L.sortBy (compare `on` snd) $ M.toList dataIn -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Tue Oct 9 08:48:56 2018 From: michael at snoyman.com (Michael Snoyman) Date: Tue, 9 Oct 2018 11:48:56 +0300 Subject: [Haskell-beginners] why is ScopedTypeVariables not fixing this error? In-Reply-To: References: Message-ID: You need to put a `forall a.` in front of the `Ord a` constraint. To quote the manual on the language extension[1] > Enable lexical scoping of type variables explicitly introduced with forall . If it helps, the requirement of forall to be able to refer to the variable was non-obvious to me the first time I tried to use the extension. [1] https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#ghc-flag--XScopedTypeVariables On Tue, Oct 9, 2018 at 11:45 AM Dennis Raddle wrote: > In the following snippet from a program in progress (designed to compute > percentile rank for arbitrary lists of values) , I was hoping to declare > types of functions within the main function just as a way of helping myself > catch type errors. I'm getting the error "Can't match 'a' with 'a1'.... > where 'a' is rigid type variable... etc. etc." on the line indicated in the > comment below. The usual error I get when I try to do this without > ScopedTypeVariables. So, I thought that ScopedTypeVariables was supposed to > allow this kind of usage. What am I doing wrong? > > > {-# LANGUAGE ScopedTypeVariables #-} > > import qualified Data.Map as M > import qualified Data.List as L > import Data.Map(Map) > import Data.Function > > -- > data PercentileData = PercentileData Double Double > > -- new attempt, October 2018: using new PercentileData construct to > -- represent percentile in both ways. (at/below, or below) > computePercentile :: Ord a => Map a Double -> Map a PercentileData > computePercentile dataIn = error "foo" > where > pairs :: [(a,Double)] -- THIS IS THE LINE GETTING THE ERROR > pairs = L.sortBy (compare `on` snd) $ M.toList dataIn > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Tue Oct 9 08:55:00 2018 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 9 Oct 2018 01:55:00 -0700 Subject: [Haskell-beginners] why is ScopedTypeVariables not fixing this error? In-Reply-To: References: Message-ID: That was easy. Thanks. I actually tried putting forall a in front of the line getting the error, but to no avail. Now fixed. D On Tue, Oct 9, 2018 at 1:49 AM Michael Snoyman wrote: > You need to put a `forall a.` in front of the `Ord a` constraint. To quote > the manual on the language extension[1] > > > Enable lexical scoping of type variables explicitly introduced with > forall. > > If it helps, the requirement of forall to be able to refer to the variable > was non-obvious to me the first time I tried to use the extension. > > [1] > https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#ghc-flag--XScopedTypeVariables > > On Tue, Oct 9, 2018 at 11:45 AM Dennis Raddle > wrote: > >> In the following snippet from a program in progress (designed to compute >> percentile rank for arbitrary lists of values) , I was hoping to declare >> types of functions within the main function just as a way of helping myself >> catch type errors. I'm getting the error "Can't match 'a' with 'a1'.... >> where 'a' is rigid type variable... etc. etc." on the line indicated in the >> comment below. The usual error I get when I try to do this without >> ScopedTypeVariables. So, I thought that ScopedTypeVariables was supposed to >> allow this kind of usage. What am I doing wrong? >> >> >> {-# LANGUAGE ScopedTypeVariables #-} >> >> import qualified Data.Map as M >> import qualified Data.List as L >> import Data.Map(Map) >> import Data.Function >> >> -- >> data PercentileData = PercentileData Double Double >> >> -- new attempt, October 2018: using new PercentileData construct to >> -- represent percentile in both ways. (at/below, or below) >> computePercentile :: Ord a => Map a Double -> Map a PercentileData >> computePercentile dataIn = error "foo" >> where >> pairs :: [(a,Double)] -- THIS IS THE LINE GETTING THE ERROR >> pairs = L.sortBy (compare `on` snd) $ M.toList dataIn >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Thu Oct 11 11:34:20 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Thu, 11 Oct 2018 11:34:20 +0000 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa>, Message-ID: Hello, So I end-up for now with two singletons for my SomeDataCollection So I red the Datacollection from an xml file (col) then I create the SomeDataCollection type depending on a bunch of values found in the Datacollection. like this. return $ if "ref-" `isPrefixOf` imagePrefix col then case imageSuffix col of (Just "cbf") -> SomeDataCollection SCaracterization SCbf (coerce col) (Just "h5") -> SomeDataCollection SCaracterization SHdf5 (coerce col) (Just _) -> SomeDataCollection SCaracterization SCbf (coerce col) Nothing -> SomeDataCollection SCaracterization SCbf (coerce col) else case imageSuffix col of (Just "cbf") -> SomeDataCollection SCollect SCbf (coerce col) (Just "h5") -> SomeDataCollection SCollect SHdf5 (coerce col) (Just _) -> SomeDataCollection SCollect SCbf (coerce col) Nothing -> SomeDataCollection SCollect SCbf (coerce col) Now I would like to do something like let t = if "ref-" `isPrefixOf` imagePrefix col then SCaracterization else SCollect and then return SomeDatacollection t f (coerce col) But If I try to do this I have an error like this src/ISPyB/Soap.hs:119:37-44: error: • Couldn't match type ‘'Collect’ with ‘'Caracterization’ Expected type: SCollectType 'Caracterization Actual type: SCollectType 'Collect • In the expression: SCollect In the expression: if "ref-" `isPrefixOf` imagePrefix col then SCaracterization else SCollect In an equation for ‘t’: t = if "ref-" `isPrefixOf` imagePrefix col then SCaracterization else SCollect how can I fix this and make the code better to read. thanks Fred From kitttoran at gmail.com Thu Oct 11 21:35:06 2018 From: kitttoran at gmail.com (Nikita Fufaev) Date: Fri, 12 Oct 2018 00:35:06 +0300 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa> Message-ID: return (if "ref-" `isPrefixOf` imagePrefix col then cont SCaracterization else cont SCollect) where cont :: forall coc. SCaracterizationOrCollect coc -> SomeDataCollection cont sing = case imageSuffix col of (Just "cbf") -> SomeDataCollection sing SCbf (coerce col) (Just "h5") -> SomeDataCollection sing SHdf5 (coerce col) (Just _) -> SomeDataCollection sing SCbf (coerce col) Nothing -> SomeDataCollection sing SCbf (coerce col) You could also get rid of SomeDataCollection in a similar way: data DataCollection a b = DataCollection (SCaracterizationOrCollect a) (SSuffix b) String parseFileName :: forall c. String -> (forall a b. DataCollection a b -> c) -> c parseFileName col cont = (if "ref-" `isPrefixOf` imagePrefix col then cont2 SCaracterization else cont2 SCollect) where cont2 :: forall coc. SCaracterizationOrCollect coc -> c cont2 sing = case imageSuffix col of (Just "cbf") -> cont $ DataCollection sing SCbf (coerce col) (Just "h5") -> cont $ DataCollection sing SHdf5 (coerce col) (Just _) -> cont $ DataCollection sing SCbf (coerce col) Nothing -> cont $ DataCollection sing SCbf (coerce col) In general, when you want to type some expression that can be of different types depending on values, you can turn it into a function that takes polymorphic continuation as an argument. If you plan to have many tags on DataCollection and many functions that return DataCollections of different types where some tags depend on argument values and some tags are staticlly known, this style is probably easier. If you are willing to use singletons package, there is another way to do this: {-# Language TemplateHaskell, KindSignatures, TypeFamilies, DataKinds, ScopedTypeVariables #-} import Data.Coerce import Data.Singletons.TH import Data.List $(singletons [d| data Suffix = Cbf | Hdf5 data CaracterizationOrCollect = Caracterization | Collect |]) data SomeDataCollection where SomeDataCollection :: SCaracterizationOrCollect a -> SSuffix b -> DataCollection a b -> SomeDataCollection newtype DataCollection (a::CaracterizationOrCollect) (b::Suffix) = DC String someFunc :: String -> IO SomeDataCollection someFunc col = return $ withSomeSing (if "ref-" `isPrefixOf` imagePrefix col then Caracterization else Collect) (\sing -> case imageSuffix col of (Just "cbf") -> SomeDataCollection sing SCbf (coerce col) (Just "h5") -> SomeDataCollection sing SHdf5 (coerce col) (Just _) -> SomeDataCollection sing SCbf (coerce col) Nothing -> SomeDataCollection sing SCbf (coerce col)) Hopefully, when the hyped DependentTypes extension lands, this will all be authomated and we won't need to explicitly use a single singleton anymore. On 11/10/2018, PICCA Frederic-Emmanuel wrote: > Hello, So I end-up for now with two singletons for my SomeDataCollection > > So I red the Datacollection from an xml file (col) then I create the > SomeDataCollection type depending on a bunch of values found in the > Datacollection. > like this. > > return $ if "ref-" `isPrefixOf` imagePrefix col > then case imageSuffix col of > (Just "cbf") -> SomeDataCollection > SCaracterization SCbf (coerce col) > (Just "h5") -> SomeDataCollection > SCaracterization SHdf5 (coerce col) > (Just _) -> SomeDataCollection > SCaracterization SCbf (coerce col) > Nothing -> SomeDataCollection > SCaracterization SCbf (coerce col) > else case imageSuffix col of > (Just "cbf") -> SomeDataCollection > SCollect SCbf (coerce col) > (Just "h5") -> SomeDataCollection > SCollect SHdf5 (coerce col) > (Just _) -> SomeDataCollection SCollect > SCbf (coerce col) > Nothing -> SomeDataCollection SCollect > SCbf (coerce col) > > > Now I would like to do something like > > let t = if "ref-" `isPrefixOf` imagePrefix col > then SCaracterization > else SCollect > > and then > > return SomeDatacollection t f (coerce col) > > But If I try to do this I have an error like this > > > src/ISPyB/Soap.hs:119:37-44: error: > • Couldn't match type ‘'Collect’ with ‘'Caracterization’ > Expected type: SCollectType 'Caracterization > Actual type: SCollectType 'Collect > • In the expression: SCollect > In the expression: > if "ref-" `isPrefixOf` imagePrefix col then > SCaracterization > else > SCollect > In an equation for ‘t’: > t = if "ref-" `isPrefixOf` imagePrefix col then > SCaracterization > else > SCollect > > how can I fix this and make the code better to read. > > thanks > > Fred > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Nikita Fufaev, +7 999 825-95-07 From frederic-emmanuel.picca at synchrotron-soleil.fr Fri Oct 12 12:35:54 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Fri, 12 Oct 2018 12:35:54 +0000 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa> , Message-ID: I endup with this solution, whcih is for me quite elegant. Maybe this could be generalize with the singleton package. mkSomeDataCollection :: DataCollection a b -> SomeDataCollection mkSomeDataCollection c = withSCollectType $ \s -> withSCollectSourceFormat $ \f -> SomeDataCollection s f (coerce c) where withSCollectType :: (forall c. SCollectType c -> SomeDataCollection) -> SomeDataCollection withSCollectType cont = if "ref-" `isPrefixOf` imagePrefix c then cont SCaracterization else cont SCollect withSCollectSourceFormat :: (forall c .SCollectSourceFormat c -> SomeDataCollection) -> SomeDataCollection withSCollectSourceFormat cont = case imageSuffix c of (Just "cbf") -> cont SCbf (Just "h5") -> cont SHdf5 (Just _) -> cont SCbf Nothing -> cont SCbf I can not use singleton since I decided to stick to Debian stable/unstable Cheers and thanks a lot for the help. Frederic From frederic-emmanuel.picca at synchrotron-soleil.fr Fri Oct 12 13:26:21 2018 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Fri, 12 Oct 2018 13:26:21 +0000 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa> , , Message-ID: Nervertheless, what is the advantage of this Singleton things vs a TypeClass with an instance by type ? From gmarquez at ciencias.unam.mx Sun Oct 14 00:44:42 2018 From: gmarquez at ciencias.unam.mx (Gustavo Arturo Marquez Flores) Date: Sat, 13 Oct 2018 19:44:42 -0500 Subject: [Haskell-beginners] I can't start WinGHCi Haskell Message-ID: Hi, I want to start with Haskell language programming. But when I launch the WinGHCi program I got he followin message: [image: image.png] What can I do ? How to resolve this problem ? I use Windows 10 plataform. I aprecite your help for resolving this problem to me. Thanks a lot. -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 45599 bytes Desc: not available URL: From brodyberg at gmail.com Sun Oct 14 00:57:42 2018 From: brodyberg at gmail.com (Brody Berg) Date: Sat, 13 Oct 2018 17:57:42 -0700 Subject: [Haskell-beginners] I can't start WinGHCi Haskell In-Reply-To: References: Message-ID: Looks like it isn’t installed correctly - or something it depends on is missing. On Sat, Oct 13, 2018 at 17:45 Gustavo Arturo Marquez Flores < gmarquez at ciencias.unam.mx> wrote: > Hi, > > I want to start with Haskell language programming. But when I launch > the WinGHCi program I got he followin message: > > [image: image.png] > > What can I do ? How to resolve this problem ? I use Windows 10 plataform. > > I aprecite your help for resolving this problem to me. > > Thanks a lot. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 45599 bytes Desc: not available URL: From jaakko.luttinen at iki.fi Sun Oct 14 07:15:06 2018 From: jaakko.luttinen at iki.fi (Jaakko Luttinen) Date: Sun, 14 Oct 2018 10:15:06 +0300 Subject: [Haskell-beginners] Lifting over record syntax Message-ID: <294a3680-dead-c2d0-8796-34f15bc9ace5@iki.fi> Hi! Let's consider this simple data structure: data Person = Person {name::String, age::Int} deriving Show Now, I can create maybe-people like in applicative style: Person <$> Just "John Doe" <*> Nothing or in monad style: do name' <- Just "John Doe" age' <- Nothing return Person {name=name', age=age'} The problem with the first approach is that it depends on the order of the arguments because it doesn't utilize the record syntax. The problem with the second approach is that there's a bit of unnecessary boilerplate (e.g., name' and age' variables). I would like to get the benefits of the the record syntax but with similar code simplicity as the applicative style has. Do you have ideas is this possible? My non-working pseudo-code would look like: Person <$> {name=Just "John Doe", age=Nothing} But this doesn't work, it's syntax error. Any ideas for a nice syntax? Cheers, Jaakko From utprimum at gmail.com Sun Oct 14 07:49:38 2018 From: utprimum at gmail.com (Ut Primum) Date: Sun, 14 Oct 2018 09:49:38 +0200 Subject: [Haskell-beginners] I can't start WinGHCi Haskell In-Reply-To: References: Message-ID: Sometimes this kind of errors are caused by the fact that the PATH environment variable hasn't been modified correctly during installation, so maybe you should do it manually Il dom 14 ott 2018, 02:58 Brody Berg ha scritto: > Looks like it isn’t installed correctly - or something it depends on is > missing. > > On Sat, Oct 13, 2018 at 17:45 Gustavo Arturo Marquez Flores < > gmarquez at ciencias.unam.mx> wrote: > >> Hi, >> >> I want to start with Haskell language programming. But when I launch >> the WinGHCi program I got he followin message: >> >> [image: image.png] >> >> What can I do ? How to resolve this problem ? I use Windows 10 plataform. >> >> I aprecite your help for resolving this problem to me. >> >> Thanks a lot. >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 45599 bytes Desc: not available URL: From gmarquez at ciencias.unam.mx Sun Oct 14 21:58:22 2018 From: gmarquez at ciencias.unam.mx (Gustavo Arturo Marquez Flores) Date: Sun, 14 Oct 2018 16:58:22 -0500 Subject: [Haskell-beginners] I can't start WinGHCi Haskell In-Reply-To: References: Message-ID: OK, thanks a lot. I'll do that manually. El dom., 14 oct. 2018 a las 2:50, Ut Primum () escribió: > Sometimes this kind of errors are caused by the fact that the PATH > environment variable hasn't been modified correctly during installation, so > maybe you should do it manually > > Il dom 14 ott 2018, 02:58 Brody Berg ha scritto: > >> Looks like it isn’t installed correctly - or something it depends on is >> missing. >> >> On Sat, Oct 13, 2018 at 17:45 Gustavo Arturo Marquez Flores < >> gmarquez at ciencias.unam.mx> wrote: >> >>> Hi, >>> >>> I want to start with Haskell language programming. But when I launch >>> the WinGHCi program I got he followin message: >>> >>> [image: image.png] >>> >>> What can I do ? How to resolve this problem ? I use Windows 10 plataform. >>> >>> I aprecite your help for resolving this problem to me. >>> >>> Thanks a lot. >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 45599 bytes Desc: not available URL: From kitttoran at gmail.com Mon Oct 15 00:06:19 2018 From: kitttoran at gmail.com (Nikita Fufaev) Date: Mon, 15 Oct 2018 03:06:19 +0300 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: <20181002165648.tzmyistn2uwiwmbo@x60s.casa> <20181003122135.wf2lryw4zjxl67v5@x60s.casa> <20181004131034.dcb63i4srjy7cypm@x60s.casa> Message-ID: I'm not sure what you mean by TypeClass with an instance by type method, can you elaborate on that? BTW i'm sorry for poor formatting in my messages, i hope my code samples are understandable despite the fact that there are line breaks in them where there shouldn't be. On 12/10/2018, PICCA Frederic-Emmanuel wrote: > Nervertheless, what is the advantage of this Singleton things vs a TypeClass > with an instance by type ? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Nikita Fufaev, +7 999 825-95-07 From markus.l2ll at gmail.com Mon Oct 29 18:42:14 2018 From: markus.l2ll at gmail.com (=?UTF-8?B?TWFya3VzIEzDpGxs?=) Date: Mon, 29 Oct 2018 19:42:14 +0100 Subject: [Haskell-beginners] Tagged types In-Reply-To: References: Message-ID: Hi Fredric, below are two ways to solve it, first with GADTs, the other with type classes. But I think in both cases you need to define the specific handling of the types in multiple places. With GADT's you need to add yet another constructor for yet another `t`. With type classes you need to specify the type in-line at the place you branch off, not sure how elegant that is. The singleton based approach is perhaps better than both of the below if your set of types is closed, since you only keep the string in one data constructor (in the `A "here"`), while with a GADT you have it nested in one of the AHdf5 or ACbf. On the other hand singletons need some extensions to be turned. Hope it helps, code follows: data A t = A String data Unchecked data Hdf5 data Cbf -- * A with GADT data A' where AHdf5 :: A Hdf5 -> A' ACbf :: A Cbf -> A' AUnchecked :: A Unchecked -> A' check :: A Unchecked -> A' check a = case a of A str | suffix ".h5" -> AHdf5 (A str) | suffix ".cdf" -> ACbf (A str) | otherwise -> AUnchecked (A str) where suffix suf = suf `isSuffixOf` str -- * Type classes type SomethnigCommon = () class Continue a where go :: A a -> SomethnigCommon instance Continue Hdf5 where go (A hdf5) = undefined -- implementation for hdf5 here instance Continue Cbf where go (A cbf) = undefined -- implementation for cbf here instance Continue Unchecked where go (A unchecked) = undefined -- implementation for unchecked here check' :: A Unchecked -> SomethnigCommon check' a = case a of A str | suffix ".h5" -> go (A str :: A Hdf5) | suffix ".cdf" -> go (A str :: A Cbf) | otherwise -> go (A str :: A Unchecked) where suffix suf = suf `isSuffixOf` str On Tue, Oct 2, 2018 at 6:48 PM PICCA Frederic-Emmanuel < frederic-emmanuel.picca at synchrotron-soleil.fr> wrote: > Hello > > > suppose that I have a bunch of type like this > > data Unchecked > data Hdf5 > data Cbf > > data A t > A String > > The A thing come from a database as A Unchecked > > now if I read the String and it ends with .h5, I have a A Hdf5 type > and If the string end with .cbf, I have a A Cbf. > > So I would like a function which allow to return a A Hdf5 or a A Cbf > depending on the String content. > > check :: A Unchecked -> A ??? > check = ??? > > Is it possible to do this ? > > Thanks > > Frederic > > PS: At the end I will have more tha one tag. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Markus Läll -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony_clayden at clear.net.nz Tue Oct 30 03:20:11 2018 From: anthony_clayden at clear.net.nz (Anthony Clayden) Date: Tue, 30 Oct 2018 16:20:11 +1300 Subject: [Haskell-beginners] Lifting over record syntax Message-ID: Hi Jaakko, oh dear you've picked on the most embarrassing part of Haskell. > data Person = Person {name::String, age::Int} deriving Show > > Now, I can create maybe-people like in applicative style: > > Person <$> Just "John Doe" <*> Nothing Hmm? That returns Nothing -- is that what you expect? Perhaps Person <$> Just "John Doe" <*> Just undefined But why not Just $ Person "John Doe" undefined > The problem with the [applicative] approach > is that it depends on the order of the arguments > because it doesn't utilize the record syntax. You'd think that a leading-edge language like Haskell would have really powerful record abstractions. With ways to avoid the shackles of argument ordering. Then it's sad to admit Haskell's records are feeble. Back in Haskell 98 people were saying "surely we can do better!" Well, essentially nothing's happened. So records are no more than pretty(-ish?) syntax for the ordered arguments style. The label names are not first-class. And field labels for building records only work in very restricted syntactic positions, as you point out: > I would like to get the benefits of the the record syntax > but with similar code simplicity as the applicative style has. > Do you have ideas is this possible? > My non-working pseudo-code would look like: > > Person <$> {name=Just "John Doe", age=Nothing} > > But this doesn't work, it's syntax error. You want that bit in braces to be a free-standing expression. That's called "anonymous/extensible records" (search Haskell wiki). "Anonymous" because it's not tied to any particular datatype. It's self-describing: I am a record with two fields labelled `name, age`; and the order of the labelled fields should be arbitrary. "Extensible" because you could start a record with just one labelled field, and extend it with another labelled field. But I'm not sure what the `Maybe` wrapping is doing for you? I'm going to ignore it. I have some good news and some bad news. There is a Haskell you can do n = (name = "John Doe") -- note round parens n_a = (age = undefined | n) -- | for extend the record p = Person n_a For that you need a slightly different data decl data Person = Person (Rec (name :: String, age :: Int)) deriving Show Round parens again; and a mysterious type constructor. But these records are first-class values. (They're a special variety of tuples.) Perhaps you don't need a datatype? type Person = Rec (name :: String, age :: Int) Then you don't need to apply a data constructor. This style of records is 'Trex' -- Typed Records with extensibility https://www.haskell.org/hugs/pages/hugsman/exts.html#sect7.2 The bad news: Trex is available only in a very old Haskell system, Hugs. So old that its download has bitrotted, see note here https://mail.haskell.org/pipermail/hugs-bugs/2018-July/001914.html GHC has had 12 years to come up with something comparable/better. So far, nothing. If you're wanting to get all Applicative and Functorial in GHC, there are heaps of record systems based around Lenses. http://hackage.haskell.org/package/lens-tutorial But that's going way beyond Beginners level; you'll need to call on Template Haskell; and probably add some plumbing of your own. (And under the hood you still have ordered arguments; they're rather better encapsulated.) AntC -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony_clayden at clear.net.nz Wed Oct 31 09:52:21 2018 From: anthony_clayden at clear.net.nz (Anthony Clayden) Date: Wed, 31 Oct 2018 22:52:21 +1300 Subject: [Haskell-beginners] Lifting over record syntax In-Reply-To: References: Message-ID: On Tue, 30 Oct 2018 at 4:20 PM, Anthony Clayden wrote: > > data Person = Person {name::String, age::Int} deriving Show > > > > > Now, I can create maybe-people like in applicative style: > > > > Person <$> Just "John Doe" <*> Nothing > > ... field labels for building records only work > in very restricted syntactic positions, ... > > To tease out that remark a little: Data constructor `Person` is first-class; we could go person' = Person person' <$> Just "John Doe" <*> Nothing But the following two are nothing like equivalent; so record syntax is not even referentially transparent: Person{ name = "Jane Roe", age = 37 } -- builds a Person record person'{ name = "Jane Roe", age = 37 } In the second, the token preceding the `{ ... }` is not a data constructor (because it starts lower case), so is taken to be a variable/expression denoting a value of type `Person`; and this is datatype update syntax. Why of type `Person`? Because field labels `name` and `age` come from there, and under H98 records, they can be associated only with a single type. Then `person'` is the wrong type, and you'll get a type error. Although both look like a name (of function type) adjacent to a term { in braces}, neither is function application. AntC -------------- next part -------------- An HTML attachment was scrubbed... URL: