From mihai.maruseac at gmail.com Mon Apr 3 00:41:33 2017 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Sun, 2 Apr 2017 17:41:33 -0700 Subject: [Haskell-beginners] [Call for Contributions] Haskell Communities and Activities Report, May 2017 edition (32nd edition) Message-ID: Dear all, We would like to collect contributions for the 32nd edition (10000th edition) of the ============================================================ Haskell Communities & Activities Report http://www.haskell.org/haskellwiki/Haskell_Communities_and_Activities_Report Submission deadline: 30 April 2017 (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: The usual format is a LaTeX source file, adhering to the template that is available at: http://haskell.org/communities/05-2017/template.tex There is also a LaTeX style file at http://haskell.org/communities/05-2017/hcar.sty that you can use to preview your entry. If you do not know LaTeX or don't want to use it or don't have time to translate your entry into it, then please use plain text, it is better to have an entry in plain-text which we will translate than not have it at all. 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. Please 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 info at maximka.de Thu Apr 6 15:37:22 2017 From: info at maximka.de (info at maximka.de) Date: Thu, 6 Apr 2017 17:37:22 +0200 (CEST) Subject: [Haskell-beginners] how does hgearman-worker work? In-Reply-To: References: <214333272.46677.1489609119086@communicator.strato.de> Message-ID: <1866905711.42388.1491493042744@communicator.strato.de> A while ago I asked similar question about hgearman client. With help I got in the List (https://mail.haskell.org/pipermail/beginners/2017-March/017435.html) and I implemented a gearman client in Haskell. (here the implementation http://stackoverflow.com/questions/42774191/how-does-hgearman-client-work) Unfortunately I need again some help be implementation of gearman worker. I post here only the snippet with the badly implemented code in hope to find again some help. (Complete implementation: http://stackoverflow.com/questions/43155857/how-does-hgearman-worker-work) Right gc -> do (res, _) <- flip S.runStateT gc $ do g <- (W.registerWorker name func) t <- W.runWorker gc (return ()) return t >> return () return res This throws exception: Couldn't match expected type `S.StateT Network.Gearman.Internal.GearmanClient IO a0' with actual type `IO GHC.Conc.Sync.ThreadId' In a stmt of a 'do' block: t <- W.runWorker gc (return ()) In the second argument of `($)', namely `do { g <- (W.registerWorker name func); t <- W.runWorker gc (return ()); return t >> return () } What do I wrong with W.runWorker gc (return ())? runWorker :: GearmanClient -> Gearman () -> IO ThreadId https://hackage.haskell.org/package/hgearman-0.1.0.2/docs/Network-Gearman-Worker.html Best regards, Alexei From toad3k at gmail.com Thu Apr 6 17:54:30 2017 From: toad3k at gmail.com (David McBride) Date: Thu, 6 Apr 2017 13:54:30 -0400 Subject: [Haskell-beginners] how does hgearman-worker work? In-Reply-To: <1866905711.42388.1491493042744@communicator.strato.de> References: <214333272.46677.1489609119086@communicator.strato.de> <1866905711.42388.1491493042744@communicator.strato.de> Message-ID: There are a couple problems. One is that runWorker has a type of IO ThreadId. I have no idea why he would write it that way in his API. If you want to run it from within StateT GearmanClient IO, you must use liftIO. liftIO :: (MonadIO m) => IO a -> StateT s IO instance MonadIO (StateT s IO) where liftIO :: IO a -> StateT s IO a liftIO $ runWorker gc whatever. When you are working in monadic code, you connect monadic components based on their types. If you are a procedure someprocedure :: IO ??? Then every statement you used must some form of ???. runWorker returns (IO ThreadId), return () returns (IO ()), return res returns IO (whatever type res is). I'm not sure what you intend to do with the threadId, save it or ignore it, but you might try something like this. someprocedure' :: IO (Maybe ThreadId) someprocedure' = do connectGearman >>= \case Left e -> return Nothing Right gc -> do (res, _) <- flip runStateT gc $ do g <- registerWorker undefined undefined t <- liftIO $ runWorker gc undefined return $ Just t return res This is just a guess based on what I know about gearman and that particular api choice. He may have intended you to use runWorker outside of the setup phase. He certainly doesn't prevent it. someprocedure' :: IO () someprocedure' = do gs <- connectGearman >>= \case Left e -> return [] Right gc -> do (res, _) <- flip runStateT gc $ do g <- registerWorker undefined undefined g2 <- registerWorker undefined undefined return $ [g,g2] return res mapM_ (\g -> runWorker g (return ())) gs On Thu, Apr 6, 2017 at 11:37 AM, wrote: > A while ago I asked similar question about hgearman client. With help I got in the List (https://mail.haskell.org/pipermail/beginners/2017-March/017435.html) and I implemented a gearman client in Haskell. (here the implementation http://stackoverflow.com/questions/42774191/how-does-hgearman-client-work) > > Unfortunately I need again some help be implementation of gearman worker. > > I post here only the snippet with the badly implemented code in hope to find again some help. (Complete implementation: http://stackoverflow.com/questions/43155857/how-does-hgearman-worker-work) > > Right gc -> do > (res, _) <- flip S.runStateT gc $ do > g <- (W.registerWorker name func) > t <- W.runWorker gc (return ()) > return t >> return () > > return res > > This throws exception: > Couldn't match expected type `S.StateT > Network.Gearman.Internal.GearmanClient IO a0' > with actual type `IO GHC.Conc.Sync.ThreadId' > In a stmt of a 'do' block: t <- W.runWorker gc (return ()) > In the second argument of `($)', namely > `do { g <- (W.registerWorker name func); > t <- W.runWorker gc (return ()); > return t >> return () } > > > What do I wrong with W.runWorker gc (return ())? > > runWorker :: GearmanClient -> Gearman () -> IO ThreadId > https://hackage.haskell.org/package/hgearman-0.1.0.2/docs/Network-Gearman-Worker.html > > Best regards, > Alexei > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From info at maximka.de Thu Apr 6 21:43:19 2017 From: info at maximka.de (info at maximka.de) Date: Thu, 6 Apr 2017 23:43:19 +0200 (CEST) Subject: [Haskell-beginners] how does hgearman-worker work? In-Reply-To: References: <214333272.46677.1489609119086@communicator.strato.de> <1866905711.42388.1491493042744@communicator.strato.de> Message-ID: <1851063228.51296.1491514999631@communicator.strato.de> Thank you very much, David. > If you want to run it from within StateT GearmanClient IO, you must > use liftIO. The execution of the worker implementation below shows the ThreadId but the worker doesn't grab any job from gearmand as expected. GRAB_JOB, wich sends gmLoop (https://github.com/jperson/hgearman-client/blob/master/Network/Gearman/Worker.hs#L29), appears in gearmand logs but the worker close the connection before gearmand sends GEARMAN_COMMAND_JOB_ASSIGN replay. It looks like the worker does not execute gmWait. {-# LANGUAGE LambdaCase #-} import qualified Control.Monad.State as S import qualified Data.ByteString.Char8 as B import qualified Network.Gearman.Client as C import qualified Network.Gearman.Worker as W import Network.Gearman.Internal (Function, Port) import Network.Socket (HostName) import GHC.Conc.Sync (ThreadId) main :: IO () main = do work >>= \ case Nothing -> putStrLn "nothing" Just t -> putStrLn $ show t return () work :: IO (Maybe ThreadId) work = do connect >>= \case Left e -> error $ B.unpack e Right gc -> do (res, _) <- flip S.runStateT gc $ do g <- W.registerWorker ((B.pack "foo")::Function) (\_ -> B.pack "bar") t <- S.liftIO $ W.runWorker gc (return g) return $ Just t return res where connect = C.connectGearman (B.pack "worker-id-123") ("localhost"::HostName) (4730::Port) > This is just a guess based on what I know about gearman and that > particular api choice. He may have intended you to use runWorker > outside of the setup phase. He certainly doesn't prevent it. > > someprocedure' :: IO () > someprocedure' = do > gs <- connectGearman >>= \case > Left e -> return [] > Right gc -> do > (res, _) <- flip runStateT gc $ do > g <- registerWorker undefined undefined > g2 <- registerWorker undefined undefined > return $ [g,g2] > return res > > mapM_ (\g -> runWorker g (return ())) gs > I'm not sure it could work in this way because runWorker :: GearmanClient -> Gearman () -> IO ThreadId and connectGearman result is of type IO (Either GearmanError GearmanClient) Best regards, Alexei > On 06 April 2017 at 19:54 David McBride wrote: > > > There are a couple problems. One is that runWorker has a type of IO > ThreadId. I have no idea why he would write it that way in his API. > If you want to run it from within StateT GearmanClient IO, you must > use liftIO. > > liftIO :: (MonadIO m) => IO a -> StateT s IO > > instance MonadIO (StateT s IO) where > liftIO :: IO a -> StateT s IO a > > liftIO $ runWorker gc whatever. > > When you are working in monadic code, you connect monadic components > based on their types. If you are a procedure > > someprocedure :: IO ??? > > Then every statement you used must some form of ???. runWorker > returns (IO ThreadId), return () returns (IO ()), return res returns > IO (whatever type res is). I'm not sure what you intend to do with > the threadId, save it or ignore it, but you might try something like > this. > > someprocedure' :: IO (Maybe ThreadId) > someprocedure' = do > connectGearman >>= \case > Left e -> return Nothing > Right gc -> do > (res, _) <- flip runStateT gc $ do > g <- registerWorker undefined undefined > t <- liftIO $ runWorker gc undefined > return $ Just t > return res > > This is just a guess based on what I know about gearman and that > particular api choice. He may have intended you to use runWorker > outside of the setup phase. He certainly doesn't prevent it. > > someprocedure' :: IO () > someprocedure' = do > gs <- connectGearman >>= \case > Left e -> return [] > Right gc -> do > (res, _) <- flip runStateT gc $ do > g <- registerWorker undefined undefined > g2 <- registerWorker undefined undefined > return $ [g,g2] > return res > > mapM_ (\g -> runWorker g (return ())) gs > > > > On Thu, Apr 6, 2017 at 11:37 AM, wrote: > > A while ago I asked similar question about hgearman client. With help I got in the List (https://mail.haskell.org/pipermail/beginners/2017-March/017435.html) and I implemented a gearman client in Haskell. (here the implementation http://stackoverflow.com/questions/42774191/how-does-hgearman-client-work) > > > > Unfortunately I need again some help be implementation of gearman worker. > > > > I post here only the snippet with the badly implemented code in hope to find again some help. (Complete implementation: http://stackoverflow.com/questions/43155857/how-does-hgearman-worker-work) > > > > Right gc -> do > > (res, _) <- flip S.runStateT gc $ do > > g <- (W.registerWorker name func) > > t <- W.runWorker gc (return ()) > > return t >> return () > > > > return res > > > > This throws exception: > > Couldn't match expected type `S.StateT > > Network.Gearman.Internal.GearmanClient IO a0' > > with actual type `IO GHC.Conc.Sync.ThreadId' > > In a stmt of a 'do' block: t <- W.runWorker gc (return ()) > > In the second argument of `($)', namely > > `do { g <- (W.registerWorker name func); > > t <- W.runWorker gc (return ()); > > return t >> return () } > > > > > > What do I wrong with W.runWorker gc (return ())? > > > > runWorker :: GearmanClient -> Gearman () -> IO ThreadId > > https://hackage.haskell.org/package/hgearman-0.1.0.2/docs/Network-Gearman-Worker.html > > > > Best regards, > > Alexei > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From davemartinnyc at aol.com Fri Apr 7 01:26:09 2017 From: davemartinnyc at aol.com (Dave Martin) Date: Thu, 6 Apr 2017 21:26:09 -0400 Subject: [Haskell-beginners] State monad to help pass around game settings Message-ID: <15b4604c422-5e4f-81f0@webprd-m51.mail.aol.com> I'm trying to write a game with a "settings menu" where the user can adjust gameplay options. Right now I pass all the settings around as parameters. I'm trying to figure out how to use the State monad to simplify this task, but I can't figure out how to start. Or maybe my whole design approach is wrongheaded, and not in keeping with best practices. Haskell is my first language. This is the kind of thing I have now: mainM color shape = putStrLn "\n\nMain Menu" >> (putStrLn . unlines) [ "(1) Set", "(2) Display", "(3) Quit"] >> putStr "? " >> getChar >>= \c -> case c of '1' -> set color shape '2' -> display color shape '3' -> return () _ -> mainM color shape set color shape = putStrLn "\n\nSettings" >> (putStrLn . unlines) [ "(1) Color", "(2) Shape", "(3) Main Menu"] >> putStr "? " >> getChar >>= \c -> case c of '1' -> setColor color shape '2' -> setShape color shape '3' -> mainM color shape _ -> set color shape setColor color shape = putStr ("\n\nColor is " ++ color ++ ". New color? ") >> getLine >>= \cs -> set cs shape setShape color shape = putStr ("\n\nShape is " ++ shape ++ ". New shape? ") >> getLine >>= \cs -> set color cs display color shape = putStrLn ("\n\nColor is " ++ color ++ ". Shape is " ++ shape ++ ".") >> mainM color shape -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Fri Apr 7 12:33:10 2017 From: toad3k at gmail.com (David McBride) Date: Fri, 7 Apr 2017 08:33:10 -0400 Subject: [Haskell-beginners] State monad to help pass around game settings In-Reply-To: <15b4604c422-5e4f-81f0@webprd-m51.mail.aol.com> References: <15b4604c422-5e4f-81f0@webprd-m51.mail.aol.com> Message-ID: The basic outline for using StateT for settings is the following. Hopefully this will give you an idea of how to get started. import Control.Monad.State data Color = White | Red deriving (Enum, Show) data Shape = Square deriving (Enum, Show) data Stuff = Stuff deriving Show data Settings = Settings { sColor :: Color, sShape :: Shape } deriving Show data MyApp = MyApp { settings :: Settings, otherStuff :: Stuff } deriving Show main = do (_, settings) <- runStateT proc (MyApp (Settings White Square) Stuff) print settings -- A reusable prompt function. prompt :: String -> [a] -> (Char -> a) -> IO a prompt question opts c2r = do putStrLn question mapM undefined opts c <- getChar let r = c2r c -- turn a Char into a Shape or a Color. return r proc :: StateT MyApp IO () proc = do getColor getShape getColor :: StateT MyApp IO () getColor = do color <- liftIO $ prompt "What color would you like?" [Red, White] undefined MyApp settings otherstuff <- get put $ (MyApp (settings { sColor = color })) otherstuff getShape :: StateT MyApp IO () getShape = undefined On Thu, Apr 6, 2017 at 9:26 PM, Dave Martin wrote: > I'm trying to write a game with a "settings menu" where the user can adjust > gameplay options. Right now I pass all the settings around as parameters. > I'm trying to figure out how to use the State monad to simplify this task, > but I can't figure out how to start. Or maybe my whole design approach is > wrongheaded, and not in keeping with best practices. Haskell is my first > language. This is the kind of thing I have now: > > mainM color shape = > putStrLn "\n\nMain Menu" >> > (putStrLn . unlines) [ > "(1) Set", > "(2) Display", > "(3) Quit"] >> > putStr "? " >> > getChar >>= \c -> > case c of > '1' -> set color shape > '2' -> display color shape > '3' -> return () > _ -> mainM color shape > > set color shape = > putStrLn "\n\nSettings" >> > (putStrLn . unlines) [ > "(1) Color", > "(2) Shape", > "(3) Main Menu"] >> > putStr "? " >> > getChar >>= \c -> > case c of > '1' -> setColor color shape > '2' -> setShape color shape > '3' -> mainM color shape > _ -> set color shape > > setColor color shape = > putStr ("\n\nColor is " ++ color ++ ". New color? ") >> > getLine >>= \cs -> > set cs shape > > setShape color shape = > putStr ("\n\nShape is " ++ shape ++ ". New shape? ") >> > getLine >>= \cs -> > set color cs > > display color shape = > putStrLn ("\n\nColor is " ++ color ++ ". Shape is " ++ shape ++ ".") >> > mainM color shape > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From i.caught.air at gmail.com Fri Apr 7 12:41:01 2017 From: i.caught.air at gmail.com (i.caught.air at gmail.com) Date: Fri, 7 Apr 2017 08:41:01 -0400 Subject: [Haskell-beginners] State monad to help pass around game settings In-Reply-To: References: <15b4604c422-5e4f-81f0@webprd-m51.mail.aol.com> Message-ID: <58e788db.1249240a.acda0.beaa@mx.google.com> I have a metro to catch but small interesting additions worth looking into: Using `modify` and lenses, you get niceties like this to update the state: modify $ scolor .~ color Don’t forget to use ReaderT over StateT if you only need some configuration to be passed implicitly and wont mutate. Last note, `StateT s m a` relies fairly heavily on understanding the essence of monads. Your goal is to build a computation in which you’re given the ability to keep and mutate a state `s`. At the end of the day, something has to “run” that computation, which will carry out its effects `m`. produce a result `a`, and possibly give you the final state `s` if needed as well. (See runStateT vs. execStateT vs. evalStateT). Cheers, Alex. From: David McBride Sent: April 7, 2017 8:34 AM To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Subject: Re: [Haskell-beginners] State monad to help pass around game settings The basic outline for using StateT for settings is the following. Hopefully this will give you an idea of how to get started. import Control.Monad.State data Color = White | Red deriving (Enum, Show) data Shape = Square deriving (Enum, Show) data Stuff = Stuff deriving Show data Settings = Settings { sColor :: Color, sShape :: Shape } deriving Show data MyApp = MyApp { settings :: Settings, otherStuff :: Stuff } deriving Show main = do (_, settings) <- runStateT proc (MyApp (Settings White Square) Stuff) print settings -- A reusable prompt function. prompt :: String -> [a] -> (Char -> a) -> IO a prompt question opts c2r = do putStrLn question mapM undefined opts c <- getChar let r = c2r c -- turn a Char into a Shape or a Color. return r proc :: StateT MyApp IO () proc = do getColor getShape getColor :: StateT MyApp IO () getColor = do color <- liftIO $ prompt "What color would you like?" [Red, White] undefined MyApp settings otherstuff <- get put $ (MyApp (settings { sColor = color })) otherstuff getShape :: StateT MyApp IO () getShape = undefined On Thu, Apr 6, 2017 at 9:26 PM, Dave Martin wrote: > I'm trying to write a game with a "settings menu" where the user can adjust > gameplay options. Right now I pass all the settings around as parameters. > I'm trying to figure out how to use the State monad to simplify this task, > but I can't figure out how to start. Or maybe my whole design approach is > wrongheaded, and not in keeping with best practices. Haskell is my first > language. This is the kind of thing I have now: > > mainM color shape = > putStrLn "\n\nMain Menu" >> > (putStrLn . unlines) [ > "(1) Set", > "(2) Display", > "(3) Quit"] >> > putStr "? " >> > getChar >>= \c -> > case c of > '1' -> set color shape > '2' -> display color shape > '3' -> return () > _ -> mainM color shape > > set color shape = > putStrLn "\n\nSettings" >> > (putStrLn . unlines) [ > "(1) Color", > "(2) Shape", > "(3) Main Menu"] >> > putStr "? " >> > getChar >>= \c -> > case c of > '1' -> setColor color shape > '2' -> setShape color shape > '3' -> mainM color shape > _ -> set color shape > > setColor color shape = > putStr ("\n\nColor is " ++ color ++ ". New color? ") >> > getLine >>= \cs -> > set cs shape > > setShape color shape = > putStr ("\n\nShape is " ++ shape ++ ". New shape? ") >> > getLine >>= \cs -> > set color cs > > display color shape = > putStrLn ("\n\nColor is " ++ color ++ ". Shape is " ++ shape ++ ".") >> > mainM color shape > > > _______________________________________________ > 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 makos999 at gmail.com Fri Apr 7 19:51:31 2017 From: makos999 at gmail.com (Akos Marton) Date: Fri, 7 Apr 2017 18:51:31 -0100 Subject: [Haskell-beginners] Same code, system, but different arch using Win32 for reading registry. Message-ID: <4cc23963-f3b5-881a-c6b6-60ce6b1fb919@gmail.com> Dear Haskellers, The setup: Having a binary compiled on either x86 or x64 system (same installation, utilizing stack) in order to preserve compatibility against x64 systems. Actually, not to have 2 separate executable for each, that would be the overall goal. However it surprises me when running the x86 .exe utilizing Win32-2.5.4.1 package with ghc-8.0.2, reading out a registry key fails on x64 system with the following:/ / /me.exe: RegOpenKey: invalid argument (The system cannot find the file specified.)/ That would be fine, however the key does exists. When same code, same system, but the .exe built to be x64 it runs like a charm. A couple of question, which some of them eventually will not make sense, but still: - Can it be ghc code optimization issue? - but this is a runtime check in IO, if so, how? - Yes, I could use a built-in windows system command and parse the input of that; unless absolutely necessary I would not introduce another dependency (system package). Would love to solve it with the currently utilized weapons. - the issue just puzzles me... I would know the answer if possible. - Is it more library (Win32), ghc, binary I generate, issue? What library can I use to detect a system's architecture which works in this scenario? Another thing which convoluted in the issue... The function, /getSystemInfo :: IO SYSTEM_INFO, /can read out the underlying architecture. When compiled on x86 and run on x64 it would tell me: "I am running on x86". That's failure. Most importantly: what is the obvious I am missing? Thank you for your insights! Best, Akos Ps.: Would you/we need sample code to puzzle about I can quickly weld one. - not sure if necessary. -------------- next part -------------- An HTML attachment was scrubbed... URL: From official08 at live.in Tue Apr 11 17:43:13 2017 From: official08 at live.in (Frank Lugala) Date: Tue, 11 Apr 2017 17:43:13 +0000 Subject: [Haskell-beginners] What is the Best Haskell IDE in Windows? Message-ID: Can anyone please help?i tried to install Atom, Sublime, Emacs but i can not get them working on windows -------------- next part -------------- An HTML attachment was scrubbed... URL: From szymonpajzert at gmail.com Tue Apr 11 17:58:47 2017 From: szymonpajzert at gmail.com (Szymon Pajzert) Date: Tue, 11 Apr 2017 19:58:47 +0200 Subject: [Haskell-beginners] What is the Best Haskell IDE in Windows? In-Reply-To: References: Message-ID: Are they not working or they haskell plugins? On 11 April 2017 at 19:43, Frank Lugala wrote: > Can anyone please help?i tried to install Atom, Sublime, Emacs but i can > not get them working on windows > > _______________________________________________ > 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 official08 at live.in Tue Apr 11 18:38:21 2017 From: official08 at live.in (Frank Lugala) Date: Tue, 11 Apr 2017 18:38:21 +0000 Subject: [Haskell-beginners] What is the Best Haskell IDE in Windows? In-Reply-To: References: , Message-ID: Thank you Szymon.Do you have know any good suggestion or good tutorial explaining how to set up?i have searched online and tried but i cant make them working ________________________________ From: Beginners on behalf of Szymon Pajzert Sent: Tuesday, April 11, 2017 8:58:47 PM To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Subject: Re: [Haskell-beginners] What is the Best Haskell IDE in Windows? Are they not working or they haskell plugins? On 11 April 2017 at 19:43, Frank Lugala > wrote: Can anyone please help?i tried to install Atom, Sublime, Emacs but i can not get them working on windows _______________________________________________ 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 guthrie at mum.edu Wed Apr 12 14:02:48 2017 From: guthrie at mum.edu (Gregory Guthrie) Date: Wed, 12 Apr 2017 09:02:48 -0500 Subject: [Haskell-beginners] What is the Best Haskell IDE in Windows? Message-ID: <08EF9DA445C4B5439C4733E1F35705BA065BF53870F4@MAIL.cs.mum.edu> I like the HEAT simple IDE for small one-file programs, which are common in introductory classes. (We made a few local changes and additions - happy to share.) I also like using IntelliJ IDEA with Haskell plugin, and that is probably the most polished and best actual IDE. (The eclipse plugin is abandoned and depreciated.) For larger projects, Leksah is good, although the documentation is sparse (IMHO), and it has a bit of a learning/setup curve. ---------------------------------------------------------------- -----Original Message----- Sent: Wednesday, April 12, 2017 7:00 AM Subject: Beginners Digest, Vol 106, Issue 4 1. What is the Best Haskell IDE in Windows? (Frank Lugala) From code at funwithsoftware.org Wed Apr 12 22:25:10 2017 From: code at funwithsoftware.org (Patrick Pelletier) Date: Wed, 12 Apr 2017 15:25:10 -0700 Subject: [Haskell-beginners] will GHC optimize pattern-matching on integers? Message-ID: <8103b91b-b856-a891-67bb-653af8cce4ac@funwithsoftware.org> Suppose I am doing a pattern match on a large number of consecutive (or mostly-consecutive) integers: foo 0 = something foo 1 = somethingElse ... foo 1000 = anotherThing Will GHC optimize this to a table lookup, or is it going to test each integer in turn? Am I better off using a Vector or Map instead of pattern matching? Thanks, --Patrick From rahulmutt at gmail.com Thu Apr 13 08:41:31 2017 From: rahulmutt at gmail.com (Rahul Muttineni) Date: Thu, 13 Apr 2017 14:11:31 +0530 Subject: [Haskell-beginners] will GHC optimize pattern-matching on integers? In-Reply-To: <8103b91b-b856-a891-67bb-653af8cce4ac@funwithsoftware.org> References: <8103b91b-b856-a891-67bb-653af8cce4ac@funwithsoftware.org> Message-ID: Hi Patrick, Yes, this will optimise to "a nice balanced tree of decisions with dense jump tables in the leafs" [1]. You can check out the comments in [1] for more details. [1] https://github.com/ghc/ghc/blob/master/compiler/cmm/CmmSwitch.hs#L37 Hope that helps, Rahul On Thu, Apr 13, 2017 at 3:55 AM, Patrick Pelletier wrote: > Suppose I am doing a pattern match on a large number of consecutive (or > mostly-consecutive) integers: > > foo 0 = something > foo 1 = somethingElse > ... > foo 1000 = anotherThing > > Will GHC optimize this to a table lookup, or is it going to test each > integer in turn? Am I better off using a Vector or Map instead of pattern > matching? > > Thanks, > > --Patrick > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Rahul Muttineni -------------- next part -------------- An HTML attachment was scrubbed... URL: From code at funwithsoftware.org Fri Apr 14 02:11:31 2017 From: code at funwithsoftware.org (Patrick Pelletier) Date: Thu, 13 Apr 2017 19:11:31 -0700 Subject: [Haskell-beginners] will GHC optimize pattern-matching on integers? In-Reply-To: References: <8103b91b-b856-a891-67bb-653af8cce4ac@funwithsoftware.org> Message-ID: Thanks! That's exactly what I was hoping. --Patrick On 4/13/17 1:41 AM, Rahul Muttineni wrote: > Hi Patrick, > > Yes, this will optimise to "a nice balanced tree of decisions with > dense jump tables in the leafs" [1]. You can check out the comments in > [1] for more details. > > [1] https://github.com/ghc/ghc/blob/master/compiler/cmm/CmmSwitch.hs#L37 > > Hope that helps, > Rahul > > On Thu, Apr 13, 2017 at 3:55 AM, Patrick Pelletier > > wrote: > > Suppose I am doing a pattern match on a large number of > consecutive (or mostly-consecutive) integers: > > foo 0 = something > foo 1 = somethingElse > ... > foo 1000 = anotherThing > > Will GHC optimize this to a table lookup, or is it going to test > each integer in turn? Am I better off using a Vector or Map > instead of pattern matching? > > Thanks, > > --Patrick > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > > > -- > Rahul Muttineni > > > _______________________________________________ > 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 mike_k_houghton at yahoo.co.uk Fri Apr 14 18:02:37 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Fri, 14 Apr 2017 19:02:37 +0100 Subject: [Haskell-beginners] Parsing Message-ID: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> I have data PackageDec = Pkg String deriving Show and a parser for it packageP :: Parser PackageDec packageP = do literal “package" x <- identifier xs <- many ((:) <$> char '.' <*> identifier) return $ Pkg . concat $ (x:xs) so I’m parsing for this sort of string “package some.sort.of.name” and I’m trying to rewrite the packageP parser in applicative style. As a not quite correct start I have packageP' :: Parser PackageDec packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' <*> identifier) but I can’t see how to get the ‘first’ identifier into this sequence - i.e. the bit that corresponds to x <- identifier in the monadic version. in ghci λ-> :t many ((:) <$> char '.' <*> identifier) many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] so I think that somehow I need to get the ‘first’ identifier into a list just after Pkg . concat so that the whole list gets flattened and everybody is happy! Any help appreciated. Thanks Mike From toad3k at gmail.com Fri Apr 14 18:17:42 2017 From: toad3k at gmail.com (David McBride) Date: Fri, 14 Apr 2017 14:17:42 -0400 Subject: [Haskell-beginners] Parsing In-Reply-To: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> Message-ID: Try breaking it up into pieces. There a literal "package" which is dropped. There is a first identifier, then there are the rest of the identifiers (a list), then those two things are combined somehow (with :). literal "package" *> (:) <$> identifier <*> restOfIdentifiers where restOfIdentifiers :: Applicative f => f [String] restOfIdentifiers = many ((:) <$> char '.' <*> identifier I have not tested this code, but it should be close to what you are looking for. On Fri, Apr 14, 2017 at 2:02 PM, mike h wrote: > I have > data PackageDec = Pkg String deriving Show > > and a parser for it > > packageP :: Parser PackageDec > packageP = do > literal “package" > x <- identifier > xs <- many ((:) <$> char '.' <*> identifier) > return $ Pkg . concat $ (x:xs) > > so I’m parsing for this sort of string > “package some.sort.of.name” > > and I’m trying to rewrite the packageP parser in applicative style. As a not quite correct start I have > > packageP' :: Parser PackageDec > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' <*> identifier) > > but I can’t see how to get the ‘first’ identifier into this sequence - i.e. the bit that corresponds to x <- identifier in the > monadic version. > > in ghci > λ-> :t many ((:) <$> char '.' <*> identifier) > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] > > so I think that somehow I need to get the ‘first’ identifier into a list just after Pkg . concat so that the whole list gets flattened and everybody is happy! > > Any help appreciated. > > Thanks > Mike > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From fa-ml at ariis.it Fri Apr 14 18:35:32 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 14 Apr 2017 20:35:32 +0200 Subject: [Haskell-beginners] Parsing In-Reply-To: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> Message-ID: <20170414183532.GA4376@casa.casa> On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: > I have > data PackageDec = Pkg String deriving Show > > and a parser for it > > packageP :: Parser PackageDec > packageP = do > literal “package" > x <- identifier > xs <- many ((:) <$> char '.' <*> identifier) > return $ Pkg . concat $ (x:xs) > > so I’m parsing for this sort of string > “package some.sort.of.name” > > and I’m trying to rewrite the packageP parser in applicative style. As a not quite correct start I have Hello Mike, I am not really sure what you are doing here? You are parsing a dot separated list (like.this.one) but at the end you are concatenating all together, why? Are you sure you are not wanting [String] instead of String? If so, Parsec comes with some handy parser combinators [1], maybe one of them could fit your bill: -- should work packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char '.') [1] https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html From mike_k_houghton at yahoo.co.uk Fri Apr 14 19:12:14 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Fri, 14 Apr 2017 20:12:14 +0100 Subject: [Haskell-beginners] Parsing In-Reply-To: References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> Message-ID: Hi David, Thanks but I tried something like that before I posted. I’ll try again maybe I mistyped. Mike > On 14 Apr 2017, at 19:17, David McBride wrote: > > Try breaking it up into pieces. There a literal "package" which is > dropped. There is a first identifier, then there are the rest of the > identifiers (a list), then those two things are combined somehow (with > :). > > literal "package" *> (:) <$> identifier <*> restOfIdentifiers > where > restOfIdentifiers :: Applicative f => f [String] > restOfIdentifiers = many ((:) <$> char '.' <*> identifier > > I have not tested this code, but it should be close to what you are looking for. > > On Fri, Apr 14, 2017 at 2:02 PM, mike h wrote: >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a not quite correct start I have >> >> packageP' :: Parser PackageDec >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' <*> identifier) >> >> but I can’t see how to get the ‘first’ identifier into this sequence - i.e. the bit that corresponds to x <- identifier in the >> monadic version. >> >> in ghci >> λ-> :t many ((:) <$> char '.' <*> identifier) >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> so I think that somehow I need to get the ‘first’ identifier into a list just after Pkg . concat so that the whole list gets flattened and everybody is happy! >> >> Any help appreciated. >> >> Thanks >> Mike >> >> >> >> >> >> _______________________________________________ >> 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 From mike_k_houghton at yahoo.co.uk Fri Apr 14 19:19:40 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Fri, 14 Apr 2017 20:19:40 +0100 Subject: [Haskell-beginners] Parsing In-Reply-To: <20170414183532.GA4376@casa.casa> References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> <20170414183532.GA4376@casa.casa> Message-ID: Hi Francesco, Yes, I think you are right with "Are you sure you are not wanting [String] instead of String?” I could use Parsec but I’m building up a parser library from first principles i.e. newtype Parser a = P (String -> [(a,String)]) parse :: Parser a -> String -> [(a,String)] parse (P p) = p and so on…. It’s just an exercise to see how far I can get. And its good fun. So maybe I need add another combinator or to what I already have. Thanks Mike > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: > > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a not quite correct start I have > > Hello Mike, > > I am not really sure what you are doing here? You are parsing a dot > separated list (like.this.one) but at the end you are concatenating all > together, why? > Are you sure you are not wanting [String] instead of String? > > If so, Parsec comes with some handy parser combinators [1], maybe one of > them could fit your bill: > > -- should work > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char '.') > > [1] https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html > _______________________________________________ > 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 toad3k at gmail.com Fri Apr 14 19:27:16 2017 From: toad3k at gmail.com (David McBride) Date: Fri, 14 Apr 2017 15:27:16 -0400 Subject: [Haskell-beginners] Parsing In-Reply-To: References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> <20170414183532.GA4376@casa.casa> Message-ID: Working it out for myself, it should be something like: blah :: forall f. Applicative f => f PackageDec blah = package *> Pkg . mconcat <$> ((:) <$> identifier <*> restOfIdentifiers) where restOfIdentifiers :: Applicative f => f [String] restOfIdentifiers = many ((:) <$> char '.' <*> identifier) On Fri, Apr 14, 2017 at 3:19 PM, mike h wrote: > Hi Francesco, > Yes, I think you are right with "Are you sure you are not wanting [String] > instead of String?” > > I could use Parsec but I’m building up a parser library from first > principles i.e. > > newtype Parser a = P (String -> [(a,String)]) > > parse :: Parser a -> String -> [(a,String)] > parse (P p) = p > > and so on…. > > It’s just an exercise to see how far I can get. And its good fun. So maybe I > need add another combinator or to what I already have. > > Thanks > > Mike > > > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: > > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: > > I have > data PackageDec = Pkg String deriving Show > > and a parser for it > > packageP :: Parser PackageDec > packageP = do > literal “package" > x <- identifier > xs <- many ((:) <$> char '.' <*> identifier) > return $ Pkg . concat $ (x:xs) > > so I’m parsing for this sort of string > “package some.sort.of.name” > > and I’m trying to rewrite the packageP parser in applicative style. As a not > quite correct start I have > > > Hello Mike, > > I am not really sure what you are doing here? You are parsing a dot > separated list (like.this.one) but at the end you are concatenating all > together, why? > Are you sure you are not wanting [String] instead of String? > > If so, Parsec comes with some handy parser combinators [1], maybe one of > them could fit your bill: > > -- should work > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char '.') > > [1] > https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html > _______________________________________________ > 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 > From mike_k_houghton at yahoo.co.uk Fri Apr 14 19:53:47 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Fri, 14 Apr 2017 20:53:47 +0100 Subject: [Haskell-beginners] Parsing In-Reply-To: References: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C@yahoo.co.uk> <20170414183532.GA4376@casa.casa> Message-ID: Duh! I did have that - well clearly not exactly! What I’d done a couple of hours ago had the parens in the wrong place Earlier i had packageP' = literal "package" >> Pkg <$> (:) <$> identifier <*> many ((:) <$> char '.' <*> identifier) i.e. the first <$> (:) what I have now is (thanks David) packageP' = literal "package" >> Pkg <$> ((:) <$> identifier <*> many ((:) <$> char '.' <*> identifier)) :) Looking at it now what I first had is blindingly obviously wrong! Haskell often makes me feel stupid and makes me work for my code, thats why I love it! Cheers Mike > On 14 Apr 2017, at 20:27, David McBride wrote: > > Working it out for myself, it should be something like: > > blah :: forall f. Applicative f => f PackageDec > blah = package *> Pkg . mconcat <$> ((:) <$> identifier <*> restOfIdentifiers) > where > restOfIdentifiers :: Applicative f => f [String] > restOfIdentifiers = many ((:) <$> char '.' <*> identifier) > > On Fri, Apr 14, 2017 at 3:19 PM, mike h wrote: >> Hi Francesco, >> Yes, I think you are right with "Are you sure you are not wanting [String] >> instead of String?” >> >> I could use Parsec but I’m building up a parser library from first >> principles i.e. >> >> newtype Parser a = P (String -> [(a,String)]) >> >> parse :: Parser a -> String -> [(a,String)] >> parse (P p) = p >> >> and so on…. >> >> It’s just an exercise to see how far I can get. And its good fun. So maybe I >> need add another combinator or to what I already have. >> >> Thanks >> >> Mike >> >> >> On 14 Apr 2017, at 19:35, Francesco Ariis wrote: >> >> On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a not >> quite correct start I have >> >> >> Hello Mike, >> >> I am not really sure what you are doing here? You are parsing a dot >> separated list (like.this.one) but at the end you are concatenating all >> together, why? >> Are you sure you are not wanting [String] instead of String? >> >> If so, Parsec comes with some handy parser combinators [1], maybe one of >> them could fit your bill: >> >> -- should work >> packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char '.') >> >> [1] >> https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html >> _______________________________________________ >> 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 From patrick.browne at dit.ie Mon Apr 17 10:26:07 2017 From: patrick.browne at dit.ie (PATRICK BROWNE) Date: Mon, 17 Apr 2017 11:26:07 +0100 Subject: [Haskell-beginners] Conditionals where more than one case is true Message-ID: I am having difficulty in evaluating conditionals where more than one case is true. I require a program to express the following conditions: 1) x is faster than y if x is a buffolo and y is a pig. 2) x is faster than y if x is a pig and y is a slug. Both of these conditions are true (expressed in fact predicate). I include my attempt using guards (I have also tried case/if-then-else) I can apreciate that the program works when the first guard condition is met (faster Bob Joe). I am not sure why it fails on the second case (faster Bob Joe) Can I program the requirement using conditionals? Can I pattern match is some way? Is there another way to encode the requirement. Regards, Pat data E = Bob | Joe | Steve | Buffalo | Pig | Slug deriving Show fact Buffalo Bob = True fact Pig Joe = True fact Slug Steve = True faster x y | fact Buffalo x && fact Pig y = True | fact Pig x && fact Slug y = True | otherwise = False -- faster Bob Joe OK -- faster Steve Bob ***Exception: Faster.hs:(5,1)-(7,23): Non-exhaustive patterns in function fact -- This email originated from DIT. If you received this email in error, please delete it from your system. Please note that if you are not the named addressee, disclosing, copying, distributing or taking any action based on the contents of this email or attachments is prohibited. www.dit.ie Is ó ITBÁC a tháinig an ríomhphost seo. Má fuair tú an ríomhphost seo trí earráid, scrios de do chóras é le do thoil. Tabhair ar aird, mura tú an seolaí ainmnithe, go bhfuil dianchosc ar aon nochtadh, aon chóipeáil, aon dáileadh nó ar aon ghníomh a dhéanfar bunaithe ar an ábhar atá sa ríomhphost nó sna hiatáin seo. www.dit.ie Tá ITBÁC ag aistriú go Gráinseach Ghormáin – DIT is on the move to Grangegorman -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Mon Apr 17 10:54:12 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 17 Apr 2017 12:54:12 +0200 Subject: [Haskell-beginners] Conditionals where more than one case is true In-Reply-To: References: Message-ID: <20170417105412.GA14589@casa.casa> On Mon, Apr 17, 2017 at 11:26:07AM +0100, PATRICK BROWNE wrote: > I can apreciate that the program works when the first guard condition is > met (faster Bob Joe). > I am not sure why it fails on the second case (faster Bob Joe) Your `fact` function is the one that is partial fact Buffalo Bob = True fact Pig Joe = True fact Slug Steve = True -- what if all those patterns fail? You should add a line to handle "every other case", like fact Buffalo Bob = True fact Pig Joe = True fact Slug Steve = True fact _ _ = False Does that help? From patrick.browne at dit.ie Mon Apr 17 13:27:58 2017 From: patrick.browne at dit.ie (PATRICK BROWNE) Date: Mon, 17 Apr 2017 14:27:58 +0100 Subject: [Haskell-beginners] Conditionals where more than one case is true In-Reply-To: <20170417105412.GA14589@casa.casa> References: <20170417105412.GA14589@casa.casa> Message-ID: Francesco, Yes, what I was looking for. Thanks, Pat On 17 April 2017 at 11:54, Francesco Ariis wrote: > On Mon, Apr 17, 2017 at 11:26:07AM +0100, PATRICK BROWNE wrote: > > I can apreciate that the program works when the first guard condition is > > met (faster Bob Joe). > > I am not sure why it fails on the second case (faster Bob Joe) > > Your `fact` function is the one that is partial > > fact Buffalo Bob = True > fact Pig Joe = True > fact Slug Steve = True > -- what if all those patterns fail? > > You should add a line to handle "every other case", like > > fact Buffalo Bob = True > fact Pig Joe = True > fact Slug Steve = True > fact _ _ = False > > Does that help? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- This email originated from DIT. If you received this email in error, please delete it from your system. Please note that if you are not the named addressee, disclosing, copying, distributing or taking any action based on the contents of this email or attachments is prohibited. www.dit.ie Is ó ITBÁC a tháinig an ríomhphost seo. Má fuair tú an ríomhphost seo trí earráid, scrios de do chóras é le do thoil. Tabhair ar aird, mura tú an seolaí ainmnithe, go bhfuil dianchosc ar aon nochtadh, aon chóipeáil, aon dáileadh nó ar aon ghníomh a dhéanfar bunaithe ar an ábhar atá sa ríomhphost nó sna hiatáin seo. www.dit.ie Tá ITBÁC ag aistriú go Gráinseach Ghormáin – DIT is on the move to Grangegorman -------------- next part -------------- An HTML attachment was scrubbed... URL: From deepmindster at gmail.com Tue Apr 18 12:39:28 2017 From: deepmindster at gmail.com (Andrey Klaus) Date: Tue, 18 Apr 2017 15:39:28 +0300 Subject: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 In-Reply-To: References: Message-ID: Hello everybody, A small question. ----- packageP = do literal “package" ----- what is the "literal" in this code? My problem is $ ghc ParserTest.hs [1 of 1] Compiling ParserTest ( ParserTest.hs, ParserTest.o ) ParserTest.hs:11:5: Not in scope: ‘literal’ $ ghc --version The Glorious Glasgow Haskell Compilation System, version 7.10.3 Is this because I use old version of software? Thanks, Andrey 2017-04-14 21:58 GMT+03:00 : > Send Beginners mailing list submissions to > beginners at haskell.org > > To subscribe or unsubscribe via the World Wide Web, visit > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > or, via email, send a message with subject or body 'help' to > beginners-request at haskell.org > > You can reach the person managing the list at > beginners-owner at haskell.org > > When replying, please edit your Subject line so it is more specific > than "Re: Contents of Beginners digest..." > > > Today's Topics: > > 1. Parsing (mike h) > 2. Re: Parsing (David McBride) > 3. Re: Parsing (Francesco Ariis) > 4. Re: Parsing (mike h) > 5. Re: Parsing (mike h) > > > ---------------------------------------------------------------------- > > Message: 1 > Date: Fri, 14 Apr 2017 19:02:37 +0100 > From: mike h > To: The Haskell-Beginners Mailing List - Discussion of primarily > beginner-level topics related to Haskell > Subject: [Haskell-beginners] Parsing > Message-ID: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C at yahoo.co.uk> > Content-Type: text/plain; charset=utf-8 > > I have > data PackageDec = Pkg String deriving Show > > and a parser for it > > packageP :: Parser PackageDec > packageP = do > literal “package" > x <- identifier > xs <- many ((:) <$> char '.' <*> identifier) > return $ Pkg . concat $ (x:xs) > > so I’m parsing for this sort of string > “package some.sort.of.name” > > and I’m trying to rewrite the packageP parser in applicative style. As a > not quite correct start I have > > packageP' :: Parser PackageDec > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' > <*> identifier) > > but I can’t see how to get the ‘first’ identifier into this sequence - > i.e. the bit that corresponds to x <- identifier in the > monadic version. > > in ghci > λ-> :t many ((:) <$> char '.' <*> identifier) > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] > > so I think that somehow I need to get the ‘first’ identifier into a list > just after Pkg . concat so that the whole list gets flattened and > everybody is happy! > > Any help appreciated. > > Thanks > Mike > > > > > > > > ------------------------------ > > Message: 2 > Date: Fri, 14 Apr 2017 14:17:42 -0400 > From: David McBride > To: The Haskell-Beginners Mailing List - Discussion of primarily > beginner-level topics related to Haskell > Subject: Re: [Haskell-beginners] Parsing > Message-ID: > gmail.com> > Content-Type: text/plain; charset=UTF-8 > > Try breaking it up into pieces. There a literal "package" which is > dropped. There is a first identifier, then there are the rest of the > identifiers (a list), then those two things are combined somehow (with > :). > > literal "package" *> (:) <$> identifier <*> restOfIdentifiers > where > restOfIdentifiers :: Applicative f => f [String] > restOfIdentifiers = many ((:) <$> char '.' <*> identifier > > I have not tested this code, but it should be close to what you are > looking for. > > On Fri, Apr 14, 2017 at 2:02 PM, mike h > wrote: > > I have > > data PackageDec = Pkg String deriving Show > > > > and a parser for it > > > > packageP :: Parser PackageDec > > packageP = do > > literal “package" > > x <- identifier > > xs <- many ((:) <$> char '.' <*> identifier) > > return $ Pkg . concat $ (x:xs) > > > > so I’m parsing for this sort of string > > “package some.sort.of.name” > > > > and I’m trying to rewrite the packageP parser in applicative style. As a > not quite correct start I have > > > > packageP' :: Parser PackageDec > > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char > '.' <*> identifier) > > > > but I can’t see how to get the ‘first’ identifier into this sequence - > i.e. the bit that corresponds to x <- identifier in the > > monadic version. > > > > in ghci > > λ-> :t many ((:) <$> char '.' <*> identifier) > > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] > > > > so I think that somehow I need to get the ‘first’ identifier into a list > just after Pkg . concat so that the whole list gets flattened and > everybody is happy! > > > > Any help appreciated. > > > > Thanks > > Mike > > > > > > > > > > > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > ------------------------------ > > Message: 3 > Date: Fri, 14 Apr 2017 20:35:32 +0200 > From: Francesco Ariis > To: beginners at haskell.org > Subject: Re: [Haskell-beginners] Parsing > Message-ID: <20170414183532.GA4376 at casa.casa> > Content-Type: text/plain; charset=utf-8 > > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: > > I have > > data PackageDec = Pkg String deriving Show > > > > and a parser for it > > > > packageP :: Parser PackageDec > > packageP = do > > literal “package" > > x <- identifier > > xs <- many ((:) <$> char '.' <*> identifier) > > return $ Pkg . concat $ (x:xs) > > > > so I’m parsing for this sort of string > > “package some.sort.of.name” > > > > and I’m trying to rewrite the packageP parser in applicative style. As a > not quite correct start I have > > Hello Mike, > > I am not really sure what you are doing here? You are parsing a dot > separated list (like.this.one) but at the end you are concatenating all > together, why? > Are you sure you are not wanting [String] instead of String? > > If so, Parsec comes with some handy parser combinators [1], maybe one of > them could fit your bill: > > -- should work > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char '.') > > [1] https://hackage.haskell.org/package/parsec-3.1.11/docs/ > Text-Parsec-Combinator.html > > > ------------------------------ > > Message: 4 > Date: Fri, 14 Apr 2017 20:12:14 +0100 > From: mike h > To: The Haskell-Beginners Mailing List - Discussion of primarily > beginner-level topics related to Haskell > Subject: Re: [Haskell-beginners] Parsing > Message-ID: > Content-Type: text/plain; charset=utf-8 > > Hi David, > > Thanks but I tried something like that before I posted. I’ll try again > maybe I mistyped. > > Mike > > On 14 Apr 2017, at 19:17, David McBride wrote: > > > > Try breaking it up into pieces. There a literal "package" which is > > dropped. There is a first identifier, then there are the rest of the > > identifiers (a list), then those two things are combined somehow (with > > :). > > > > literal "package" *> (:) <$> identifier <*> restOfIdentifiers > > where > > restOfIdentifiers :: Applicative f => f [String] > > restOfIdentifiers = many ((:) <$> char '.' <*> identifier > > > > I have not tested this code, but it should be close to what you are > looking for. > > > > On Fri, Apr 14, 2017 at 2:02 PM, mike h > wrote: > >> I have > >> data PackageDec = Pkg String deriving Show > >> > >> and a parser for it > >> > >> packageP :: Parser PackageDec > >> packageP = do > >> literal “package" > >> x <- identifier > >> xs <- many ((:) <$> char '.' <*> identifier) > >> return $ Pkg . concat $ (x:xs) > >> > >> so I’m parsing for this sort of string > >> “package some.sort.of.name” > >> > >> and I’m trying to rewrite the packageP parser in applicative style. As > a not quite correct start I have > >> > >> packageP' :: Parser PackageDec > >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char > '.' <*> identifier) > >> > >> but I can’t see how to get the ‘first’ identifier into this sequence - > i.e. the bit that corresponds to x <- identifier in the > >> monadic version. > >> > >> in ghci > >> λ-> :t many ((:) <$> char '.' <*> identifier) > >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] > >> > >> so I think that somehow I need to get the ‘first’ identifier into a > list just after Pkg . concat so that the whole list gets flattened and > everybody is happy! > >> > >> Any help appreciated. > >> > >> Thanks > >> Mike > >> > >> > >> > >> > >> > >> _______________________________________________ > >> 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 > > > > ------------------------------ > > Message: 5 > Date: Fri, 14 Apr 2017 20:19:40 +0100 > From: mike h > To: The Haskell-Beginners Mailing List - Discussion of primarily > beginner-level topics related to Haskell > Subject: Re: [Haskell-beginners] Parsing > Message-ID: > Content-Type: text/plain; charset="utf-8" > > Hi Francesco, > Yes, I think you are right with "Are you sure you are not wanting [String] > instead of String?” > > I could use Parsec but I’m building up a parser library from first > principles i.e. > > newtype Parser a = P (String -> [(a,String)]) > > parse :: Parser a -> String -> [(a,String)] > parse (P p) = p > > and so on…. > > It’s just an exercise to see how far I can get. And its good fun. So maybe > I need add another combinator or to what I already have. > > Thanks > > Mike > > > > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: > > > > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: > >> I have > >> data PackageDec = Pkg String deriving Show > >> > >> and a parser for it > >> > >> packageP :: Parser PackageDec > >> packageP = do > >> literal “package" > >> x <- identifier > >> xs <- many ((:) <$> char '.' <*> identifier) > >> return $ Pkg . concat $ (x:xs) > >> > >> so I’m parsing for this sort of string > >> “package some.sort.of.name” > >> > >> and I’m trying to rewrite the packageP parser in applicative style. As > a not quite correct start I have > > > > Hello Mike, > > > > I am not really sure what you are doing here? You are parsing a dot > > separated list (like.this.one) but at the end you are concatenating all > > together, why? > > Are you sure you are not wanting [String] instead of String? > > > > If so, Parsec comes with some handy parser combinators [1], maybe one of > > them could fit your bill: > > > > -- should work > > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char > '.') > > > > [1] https://hackage.haskell.org/package/parsec-3.1.11/docs/ > Text-Parsec-Combinator.html package/parsec-3.1.11/docs/Text-Parsec-Combinator.html> > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners < > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners> > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: attachments/20170414/66a17133/attachment.html> > > ------------------------------ > > Subject: Digest Footer > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > ------------------------------ > > End of Beginners Digest, Vol 106, Issue 7 > ***************************************** > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Tue Apr 18 12:48:06 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 18 Apr 2017 14:48:06 +0200 Subject: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 In-Reply-To: References: Message-ID: <20170418124806.GA9027@casa.casa> On Tue, Apr 18, 2017 at 03:39:28PM +0300, Andrey Klaus wrote: > Hello everybody, > > A small question. > ----- > packageP = do > literal “package" > ----- > > what is the "literal" in this code? My problem is > > $ ghc ParserTest.hs > [1 of 1] Compiling ParserTest ( ParserTest.hs, ParserTest.o ) Hello Andrey, literal is not in scope, apparently. Did you forget to put an import at the top of ParserTest.hs? E.g.: import SomeParserModule From toad3k at gmail.com Tue Apr 18 13:22:27 2017 From: toad3k at gmail.com (David McBride) Date: Tue, 18 Apr 2017 09:22:27 -0400 Subject: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 In-Reply-To: References: Message-ID: That depends on what package you are using to parse. If you are using parsec, you can use the string function from Text.Parsec.Char. If you are using some other package, it probably has a different name for it. On Tue, Apr 18, 2017 at 8:39 AM, Andrey Klaus wrote: > Hello everybody, > > A small question. > ----- > packageP = do > literal “package" > ----- > > what is the "literal" in this code? My problem is > > $ ghc ParserTest.hs > [1 of 1] Compiling ParserTest ( ParserTest.hs, ParserTest.o ) > > ParserTest.hs:11:5: Not in scope: ‘literal’ > > $ ghc --version > The Glorious Glasgow Haskell Compilation System, version 7.10.3 > > Is this because I use old version of software? > > Thanks, > Andrey > > > > 2017-04-14 21:58 GMT+03:00 : >> >> Send Beginners mailing list submissions to >> beginners at haskell.org >> >> To subscribe or unsubscribe via the World Wide Web, visit >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> or, via email, send a message with subject or body 'help' to >> beginners-request at haskell.org >> >> You can reach the person managing the list at >> beginners-owner at haskell.org >> >> When replying, please edit your Subject line so it is more specific >> than "Re: Contents of Beginners digest..." >> >> >> Today's Topics: >> >> 1. Parsing (mike h) >> 2. Re: Parsing (David McBride) >> 3. Re: Parsing (Francesco Ariis) >> 4. Re: Parsing (mike h) >> 5. Re: Parsing (mike h) >> >> >> ---------------------------------------------------------------------- >> >> Message: 1 >> Date: Fri, 14 Apr 2017 19:02:37 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: [Haskell-beginners] Parsing >> Message-ID: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C at yahoo.co.uk> >> Content-Type: text/plain; charset=utf-8 >> >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a >> not quite correct start I have >> >> packageP' :: Parser PackageDec >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' >> <*> identifier) >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> i.e. the bit that corresponds to x <- identifier in the >> monadic version. >> >> in ghci >> λ-> :t many ((:) <$> char '.' <*> identifier) >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> so I think that somehow I need to get the ‘first’ identifier into a list >> just after Pkg . concat so that the whole list gets flattened and >> everybody is happy! >> >> Any help appreciated. >> >> Thanks >> Mike >> >> >> >> >> >> >> >> ------------------------------ >> >> Message: 2 >> Date: Fri, 14 Apr 2017 14:17:42 -0400 >> From: David McBride >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> >> >> Content-Type: text/plain; charset=UTF-8 >> >> Try breaking it up into pieces. There a literal "package" which is >> dropped. There is a first identifier, then there are the rest of the >> identifiers (a list), then those two things are combined somehow (with >> :). >> >> literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> where >> restOfIdentifiers :: Applicative f => f [String] >> restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> >> I have not tested this code, but it should be close to what you are >> looking for. >> >> On Fri, Apr 14, 2017 at 2:02 PM, mike h >> wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> > >> > packageP' :: Parser PackageDec >> > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> > '.' <*> identifier) >> > >> > but I can’t see how to get the ‘first’ identifier into this sequence - >> > i.e. the bit that corresponds to x <- identifier in the >> > monadic version. >> > >> > in ghci >> > λ-> :t many ((:) <$> char '.' <*> identifier) >> > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> > >> > so I think that somehow I need to get the ‘first’ identifier into a list >> > just after Pkg . concat so that the whole list gets flattened and >> > everybody is happy! >> > >> > Any help appreciated. >> > >> > Thanks >> > Mike >> > >> > >> > >> > >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> >> ------------------------------ >> >> Message: 3 >> Date: Fri, 14 Apr 2017 20:35:32 +0200 >> From: Francesco Ariis >> To: beginners at haskell.org >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: <20170414183532.GA4376 at casa.casa> >> Content-Type: text/plain; charset=utf-8 >> >> On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> >> Hello Mike, >> >> I am not really sure what you are doing here? You are parsing a dot >> separated list (like.this.one) but at the end you are concatenating all >> together, why? >> Are you sure you are not wanting [String] instead of String? >> >> If so, Parsec comes with some handy parser combinators [1], maybe one of >> them could fit your bill: >> >> -- should work >> packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> '.') >> >> [1] >> https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html >> >> >> ------------------------------ >> >> Message: 4 >> Date: Fri, 14 Apr 2017 20:12:14 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset=utf-8 >> >> Hi David, >> >> Thanks but I tried something like that before I posted. I’ll try again >> maybe I mistyped. >> >> Mike >> > On 14 Apr 2017, at 19:17, David McBride wrote: >> > >> > Try breaking it up into pieces. There a literal "package" which is >> > dropped. There is a first identifier, then there are the rest of the >> > identifiers (a list), then those two things are combined somehow (with >> > :). >> > >> > literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> > where >> > restOfIdentifiers :: Applicative f => f [String] >> > restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> > >> > I have not tested this code, but it should be close to what you are >> > looking for. >> > >> > On Fri, Apr 14, 2017 at 2:02 PM, mike h >> > wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> >> >> >> packageP' :: Parser PackageDec >> >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> >> '.' <*> identifier) >> >> >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> >> i.e. the bit that corresponds to x <- identifier in the >> >> monadic version. >> >> >> >> in ghci >> >> λ-> :t many ((:) <$> char '.' <*> identifier) >> >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> >> >> so I think that somehow I need to get the ‘first’ identifier into a >> >> list just after Pkg . concat so that the whole list gets flattened and >> >> everybody is happy! >> >> >> >> Any help appreciated. >> >> >> >> Thanks >> >> Mike >> >> >> >> >> >> >> >> >> >> >> >> _______________________________________________ >> >> 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 >> >> >> >> ------------------------------ >> >> Message: 5 >> Date: Fri, 14 Apr 2017 20:19:40 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset="utf-8" >> >> Hi Francesco, >> Yes, I think you are right with "Are you sure you are not wanting [String] >> instead of String?” >> >> I could use Parsec but I’m building up a parser library from first >> principles i.e. >> >> newtype Parser a = P (String -> [(a,String)]) >> >> parse :: Parser a -> String -> [(a,String)] >> parse (P p) = p >> >> and so on…. >> >> It’s just an exercise to see how far I can get. And its good fun. So maybe >> I need add another combinator or to what I already have. >> >> Thanks >> >> Mike >> >> >> > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: >> > >> > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> > >> > Hello Mike, >> > >> > I am not really sure what you are doing here? You are parsing a dot >> > separated list (like.this.one) but at the end you are concatenating all >> > together, why? >> > Are you sure you are not wanting [String] instead of String? >> > >> > If so, Parsec comes with some handy parser combinators [1], maybe one of >> > them could fit your bill: >> > >> > -- should work >> > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> > '.') >> > >> > [1] >> > https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > >> -------------- next part -------------- >> An HTML attachment was scrubbed... >> URL: >> >> >> ------------------------------ >> >> Subject: Digest Footer >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> >> ------------------------------ >> >> End of Beginners Digest, Vol 106, Issue 7 >> ***************************************** > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From info at maximka.de Tue Apr 18 14:27:18 2017 From: info at maximka.de (info at maximka.de) Date: Tue, 18 Apr 2017 16:27:18 +0200 (CEST) Subject: [Haskell-beginners] how does hgearman-worker work? In-Reply-To: <1851063228.51296.1491514999631@communicator.strato.de> References: <214333272.46677.1489609119086@communicator.strato.de> <1866905711.42388.1491493042744@communicator.strato.de> <1851063228.51296.1491514999631@communicator.strato.de> Message-ID: <1163641822.368480.1492525638219@communicator.strato.de> Finally I implemented a hgearman based worker. The code is posted on stackoverflow: http://stackoverflow.com/a/43474542/2789312 > > This is just a guess based on what I know about gearman and that > > particular api choice. He may have intended you to use runWorker > > outside of the setup phase. He certainly doesn't prevent it. I can't justify it with my less state transformer experiences. But it doesn't work for me. Both registerWorker and runWorker should use the same StateT instance because registerWorker puts a function to be executed during runWorker into StateT https://github.com/p-alik/hgearman-client/blob/master/Network/Gearman/Worker.hs#L19 and runWorker fetch and execute it https://github.com/p-alik/hgearman-client/blob/master/Network/Gearman/Worker.hs#L42 Alexei > On 06 April 2017 at 23:43 info at maximka.de wrote: > > > Thank you very much, David. > > > If you want to run it from within StateT GearmanClient IO, you must > > use liftIO. > > The execution of the worker implementation below shows the ThreadId but the worker doesn't grab any job from gearmand as expected. GRAB_JOB, wich sends gmLoop (https://github.com/jperson/hgearman-client/blob/master/Network/Gearman/Worker.hs#L29), appears in gearmand logs but the worker close the connection before gearmand sends GEARMAN_COMMAND_JOB_ASSIGN replay. It looks like the worker does not execute gmWait. > > > {-# LANGUAGE LambdaCase #-} > > import qualified Control.Monad.State as S > import qualified Data.ByteString.Char8 as B > import qualified Network.Gearman.Client as C > import qualified Network.Gearman.Worker as W > import Network.Gearman.Internal (Function, Port) > import Network.Socket (HostName) > import GHC.Conc.Sync (ThreadId) > > main :: IO () > main = do > work >>= \ case > Nothing -> putStrLn "nothing" > Just t -> putStrLn $ show t > return () > > work :: IO (Maybe ThreadId) > work = do > connect >>= \case > Left e -> error $ B.unpack e > Right gc -> do > (res, _) <- flip S.runStateT gc $ do > g <- W.registerWorker ((B.pack "foo")::Function) (\_ -> B.pack "bar") > t <- S.liftIO $ W.runWorker gc (return g) > return $ Just t > return res > where > connect = C.connectGearman (B.pack "worker-id-123") ("localhost"::HostName) (4730::Port) > > > > This is just a guess based on what I know about gearman and that > > particular api choice. He may have intended you to use runWorker > > outside of the setup phase. He certainly doesn't prevent it. > > > > someprocedure' :: IO () > > someprocedure' = do > > gs <- connectGearman >>= \case > > Left e -> return [] > > Right gc -> do > > (res, _) <- flip runStateT gc $ do > > g <- registerWorker undefined undefined > > g2 <- registerWorker undefined undefined > > return $ [g,g2] > > return res > > > > mapM_ (\g -> runWorker g (return ())) gs > > > > I'm not sure it could work in this way because runWorker :: GearmanClient -> Gearman () -> IO ThreadId and connectGearman result is of type IO (Either GearmanError GearmanClient) > > Best regards, > Alexei > > > On 06 April 2017 at 19:54 David McBride wrote: > > > > > > There are a couple problems. One is that runWorker has a type of IO > > ThreadId. I have no idea why he would write it that way in his API. > > If you want to run it from within StateT GearmanClient IO, you must > > use liftIO. > > > > liftIO :: (MonadIO m) => IO a -> StateT s IO > > > > instance MonadIO (StateT s IO) where > > liftIO :: IO a -> StateT s IO a > > > > liftIO $ runWorker gc whatever. > > > > When you are working in monadic code, you connect monadic components > > based on their types. If you are a procedure > > > > someprocedure :: IO ??? > > > > Then every statement you used must some form of ???. runWorker > > returns (IO ThreadId), return () returns (IO ()), return res returns > > IO (whatever type res is). I'm not sure what you intend to do with > > the threadId, save it or ignore it, but you might try something like > > this. > > > > someprocedure' :: IO (Maybe ThreadId) > > someprocedure' = do > > connectGearman >>= \case > > Left e -> return Nothing > > Right gc -> do > > (res, _) <- flip runStateT gc $ do > > g <- registerWorker undefined undefined > > t <- liftIO $ runWorker gc undefined > > return $ Just t > > return res > > > > This is just a guess based on what I know about gearman and that > > particular api choice. He may have intended you to use runWorker > > outside of the setup phase. He certainly doesn't prevent it. > > > > someprocedure' :: IO () > > someprocedure' = do > > gs <- connectGearman >>= \case > > Left e -> return [] > > Right gc -> do > > (res, _) <- flip runStateT gc $ do > > g <- registerWorker undefined undefined > > g2 <- registerWorker undefined undefined > > return $ [g,g2] > > return res > > > > mapM_ (\g -> runWorker g (return ())) gs > > > > > > > > On Thu, Apr 6, 2017 at 11:37 AM, wrote: > > > A while ago I asked similar question about hgearman client. With help I got in the List (https://mail.haskell.org/pipermail/beginners/2017-March/017435.html) and I implemented a gearman client in Haskell. (here the implementation http://stackoverflow.com/questions/42774191/how-does-hgearman-client-work) > > > > > > Unfortunately I need again some help be implementation of gearman worker. > > > > > > I post here only the snippet with the badly implemented code in hope to find again some help. (Complete implementation: http://stackoverflow.com/questions/43155857/how-does-hgearman-worker-work) > > > > > > Right gc -> do > > > (res, _) <- flip S.runStateT gc $ do > > > g <- (W.registerWorker name func) > > > t <- W.runWorker gc (return ()) > > > return t >> return () > > > > > > return res > > > > > > This throws exception: > > > Couldn't match expected type `S.StateT > > > Network.Gearman.Internal.GearmanClient IO a0' > > > with actual type `IO GHC.Conc.Sync.ThreadId' > > > In a stmt of a 'do' block: t <- W.runWorker gc (return ()) > > > In the second argument of `($)', namely > > > `do { g <- (W.registerWorker name func); > > > t <- W.runWorker gc (return ()); > > > return t >> return () } > > > > > > > > > What do I wrong with W.runWorker gc (return ())? > > > > > > runWorker :: GearmanClient -> Gearman () -> IO ThreadId > > > https://hackage.haskell.org/package/hgearman-0.1.0.2/docs/Network-Gearman-Worker.html > > > > > > Best regards, > > > Alexei > > > _______________________________________________ > > > 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 From official08 at live.in Wed Apr 19 00:11:14 2017 From: official08 at live.in (Frank Lugala) Date: Wed, 19 Apr 2017 00:11:14 +0000 Subject: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 In-Reply-To: References: , Message-ID: Can anyone suggest a good Haskell IDE for windows? ________________________________ From: Beginners on behalf of David McBride Sent: Tuesday, April 18, 2017 4:22 PM To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Subject: Re: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 That depends on what package you are using to parse. If you are using parsec, you can use the string function from Text.Parsec.Char. If you are using some other package, it probably has a different name for it. On Tue, Apr 18, 2017 at 8:39 AM, Andrey Klaus wrote: > Hello everybody, > > A small question. > ----- > packageP = do > literal “package" > ----- > > what is the "literal" in this code? My problem is > > $ ghc ParserTest.hs > [1 of 1] Compiling ParserTest ( ParserTest.hs, ParserTest.o ) > > ParserTest.hs:11:5: Not in scope: ‘literal’ > > $ ghc --version > The Glorious Glasgow Haskell Compilation System, version 7.10.3 > > Is this because I use old version of software? > > Thanks, > Andrey > > > > 2017-04-14 21:58 GMT+03:00 : >> >> Send Beginners mailing list submissions to >> beginners at haskell.org >> >> To subscribe or unsubscribe via the World Wide Web, visit >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners Haskell-Beginners Info Page mail.haskell.org Haskell-Beginners -- The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell About Haskell-Beginners >> or, via email, send a message with subject or body 'help' to >> beginners-request at haskell.org >> >> You can reach the person managing the list at >> beginners-owner at haskell.org >> >> When replying, please edit your Subject line so it is more specific >> than "Re: Contents of Beginners digest..." >> >> >> Today's Topics: >> >> 1. Parsing (mike h) >> 2. Re: Parsing (David McBride) >> 3. Re: Parsing (Francesco Ariis) >> 4. Re: Parsing (mike h) >> 5. Re: Parsing (mike h) >> >> >> ---------------------------------------------------------------------- >> >> Message: 1 >> Date: Fri, 14 Apr 2017 19:02:37 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: [Haskell-beginners] Parsing >> Message-ID: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C at yahoo.co.uk> >> Content-Type: text/plain; charset=utf-8 >> >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a >> not quite correct start I have >> >> packageP' :: Parser PackageDec >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' >> <*> identifier) >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> i.e. the bit that corresponds to x <- identifier in the >> monadic version. >> >> in ghci >> λ-> :t many ((:) <$> char '.' <*> identifier) >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> so I think that somehow I need to get the ‘first’ identifier into a list >> just after Pkg . concat so that the whole list gets flattened and >> everybody is happy! >> >> Any help appreciated. >> >> Thanks >> Mike >> >> >> >> >> >> >> >> ------------------------------ >> >> Message: 2 >> Date: Fri, 14 Apr 2017 14:17:42 -0400 >> From: David McBride >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> >> >> Content-Type: text/plain; charset=UTF-8 >> >> Try breaking it up into pieces. There a literal "package" which is >> dropped. There is a first identifier, then there are the rest of the >> identifiers (a list), then those two things are combined somehow (with >> :). >> >> literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> where >> restOfIdentifiers :: Applicative f => f [String] >> restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> >> I have not tested this code, but it should be close to what you are >> looking for. >> >> On Fri, Apr 14, 2017 at 2:02 PM, mike h >> wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> > >> > packageP' :: Parser PackageDec >> > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> > '.' <*> identifier) >> > >> > but I can’t see how to get the ‘first’ identifier into this sequence - >> > i.e. the bit that corresponds to x <- identifier in the >> > monadic version. >> > >> > in ghci >> > λ-> :t many ((:) <$> char '.' <*> identifier) >> > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> > >> > so I think that somehow I need to get the ‘first’ identifier into a list >> > just after Pkg . concat so that the whole list gets flattened and >> > everybody is happy! >> > >> > Any help appreciated. >> > >> > Thanks >> > Mike >> > >> > >> > >> > >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners Haskell-Beginners Info Page mail.haskell.org Haskell-Beginners -- The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell About Haskell-Beginners >> >> >> ------------------------------ >> >> Message: 3 >> Date: Fri, 14 Apr 2017 20:35:32 +0200 >> From: Francesco Ariis >> To: beginners at haskell.org >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: <20170414183532.GA4376 at casa.casa> >> Content-Type: text/plain; charset=utf-8 >> >> On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> >> Hello Mike, >> >> I am not really sure what you are doing here? You are parsing a dot >> separated list (like.this.one) but at the end you are concatenating all >> together, why? >> Are you sure you are not wanting [String] instead of String? >> >> If so, Parsec comes with some handy parser combinators [1], maybe one of >> them could fit your bill: >> >> -- should work >> packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> '.') >> >> [1] >> https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html >> >> >> ------------------------------ >> >> Message: 4 >> Date: Fri, 14 Apr 2017 20:12:14 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset=utf-8 >> >> Hi David, >> >> Thanks but I tried something like that before I posted. I’ll try again >> maybe I mistyped. >> >> Mike >> > On 14 Apr 2017, at 19:17, David McBride wrote: >> > >> > Try breaking it up into pieces. There a literal "package" which is >> > dropped. There is a first identifier, then there are the rest of the >> > identifiers (a list), then those two things are combined somehow (with >> > :). >> > >> > literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> > where >> > restOfIdentifiers :: Applicative f => f [String] >> > restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> > >> > I have not tested this code, but it should be close to what you are >> > looking for. >> > >> > On Fri, Apr 14, 2017 at 2:02 PM, mike h >> > wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> >> >> >> packageP' :: Parser PackageDec >> >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> >> '.' <*> identifier) >> >> >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> >> i.e. the bit that corresponds to x <- identifier in the >> >> monadic version. >> >> >> >> in ghci >> >> λ-> :t many ((:) <$> char '.' <*> identifier) >> >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> >> >> so I think that somehow I need to get the ‘first’ identifier into a >> >> list just after Pkg . concat so that the whole list gets flattened and >> >> everybody is happy! >> >> >> >> Any help appreciated. >> >> >> >> Thanks >> >> Mike >> >> >> >> >> >> >> >> >> >> >> >> _______________________________________________ >> >> 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 >> >> >> >> ------------------------------ >> >> Message: 5 >> Date: Fri, 14 Apr 2017 20:19:40 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset="utf-8" >> >> Hi Francesco, >> Yes, I think you are right with "Are you sure you are not wanting [String] >> instead of String?” >> >> I could use Parsec but I’m building up a parser library from first >> principles i.e. >> >> newtype Parser a = P (String -> [(a,String)]) >> >> parse :: Parser a -> String -> [(a,String)] >> parse (P p) = p >> >> and so on…. >> >> It’s just an exercise to see how far I can get. And its good fun. So maybe >> I need add another combinator or to what I already have. >> >> Thanks >> >> Mike >> >> >> > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: >> > >> > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> > >> > Hello Mike, >> > >> > I am not really sure what you are doing here? You are parsing a dot >> > separated list (like.this.one) but at the end you are concatenating all >> > together, why? >> > Are you sure you are not wanting [String] instead of String? >> > >> > If so, Parsec comes with some handy parser combinators [1], maybe one of >> > them could fit your bill: >> > >> > -- should work >> > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> > '.') >> > >> > [1] >> > https://hackage.haskell.org/package/parsec-3.1.11/docs/Text-Parsec-Combinator.html >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > >> -------------- next part -------------- >> An HTML attachment was scrubbed... >> URL: >> >> >> ------------------------------ >> >> Subject: Digest Footer >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> >> ------------------------------ >> >> End of Beginners Digest, Vol 106, Issue 7 >> ***************************************** > > > > _______________________________________________ > 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 mjt464 at gmail.com Wed Apr 19 04:54:17 2017 From: mjt464 at gmail.com (mike thomas) Date: Wed, 19 Apr 2017 14:54:17 +1000 Subject: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 In-Reply-To: References: Message-ID: I've had good luck recently with Atom and Visual Studio code on Windows 10 and MacOS. I'm looking at the Haskell-ghc-mod, ide-Haskell and language-Haskell community packages right now on Atom, and on VS Code I've got Haskell ghc-mod, Haskell syntax highlighting and Haskell linter. I hope this helps. Also, do please trim stuff from previous posts not relevant to your question. I can't do it to this reply because I'm on a phone at the moment, and deleting that much stuff is more trouble than it's worth. Cheers Mike On 19 Apr 2017 10:17 am, "Frank Lugala" wrote: Can anyone suggest a good Haskell IDE for windows? ------------------------------ *From:* Beginners on behalf of David McBride *Sent:* Tuesday, April 18, 2017 4:22 PM *To:* The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell *Subject:* Re: [Haskell-beginners] Beginners Digest, Vol 106, Issue 7 That depends on what package you are using to parse. If you are using parsec, you can use the string function from Text.Parsec.Char. If you are using some other package, it probably has a different name for it. On Tue, Apr 18, 2017 at 8:39 AM, Andrey Klaus wrote: > Hello everybody, > > A small question. > ----- > packageP = do > literal “package" > ----- > > what is the "literal" in this code? My problem is > > $ ghc ParserTest.hs > [1 of 1] Compiling ParserTest ( ParserTest.hs, ParserTest.o ) > > ParserTest.hs:11:5: Not in scope: ‘literal’ > > $ ghc --version > The Glorious Glasgow Haskell Compilation System, version 7.10.3 > > Is this because I use old version of software? > > Thanks, > Andrey > > > > 2017-04-14 21:58 GMT+03:00 : >> >> Send Beginners mailing list submissions to >> beginners at haskell.org >> >> To subscribe or unsubscribe via the World Wide Web, visit >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners Haskell-Beginners Info Page mail.haskell.org Haskell-Beginners -- The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell About Haskell-Beginners >> or, via email, send a message with subject or body 'help' to >> beginners-request at haskell.org >> >> You can reach the person managing the list at >> beginners-owner at haskell.org >> >> When replying, please edit your Subject line so it is more specific >> than "Re: Contents of Beginners digest..." >> >> >> Today's Topics: >> >> 1. Parsing (mike h) >> 2. Re: Parsing (David McBride) >> 3. Re: Parsing (Francesco Ariis) >> 4. Re: Parsing (mike h) >> 5. Re: Parsing (mike h) >> >> >> ---------------------------------------------------------------------- >> >> Message: 1 >> Date: Fri, 14 Apr 2017 19:02:37 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: [Haskell-beginners] Parsing >> Message-ID: <2C66C9DC-30AF-41C5-B9AF-0D1DA19E0A2C at yahoo.co.uk> >> Content-Type: text/plain; charset=utf-8 >> >> I have >> data PackageDec = Pkg String deriving Show >> >> and a parser for it >> >> packageP :: Parser PackageDec >> packageP = do >> literal “package" >> x <- identifier >> xs <- many ((:) <$> char '.' <*> identifier) >> return $ Pkg . concat $ (x:xs) >> >> so I’m parsing for this sort of string >> “package some.sort.of.name” >> >> and I’m trying to rewrite the packageP parser in applicative style. As a >> not quite correct start I have >> >> packageP' :: Parser PackageDec >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char '.' >> <*> identifier) >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> i.e. the bit that corresponds to x <- identifier in the >> monadic version. >> >> in ghci >> λ-> :t many ((:) <$> char '.' <*> identifier) >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> so I think that somehow I need to get the ‘first’ identifier into a list >> just after Pkg . concat so that the whole list gets flattened and >> everybody is happy! >> >> Any help appreciated. >> >> Thanks >> Mike >> >> >> >> >> >> >> >> ------------------------------ >> >> Message: 2 >> Date: Fri, 14 Apr 2017 14:17:42 -0400 >> From: David McBride >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> >> >> Content-Type: text/plain; charset=UTF-8 >> >> Try breaking it up into pieces. There a literal "package" which is >> dropped. There is a first identifier, then there are the rest of the >> identifiers (a list), then those two things are combined somehow (with >> :). >> >> literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> where >> restOfIdentifiers :: Applicative f => f [String] >> restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> >> I have not tested this code, but it should be close to what you are >> looking for. >> >> On Fri, Apr 14, 2017 at 2:02 PM, mike h >> wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> > >> > packageP' :: Parser PackageDec >> > packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> > '.' <*> identifier) >> > >> > but I can’t see how to get the ‘first’ identifier into this sequence - >> > i.e. the bit that corresponds to x <- identifier in the >> > monadic version. >> > >> > in ghci >> > λ-> :t many ((:) <$> char '.' <*> identifier) >> > many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> > >> > so I think that somehow I need to get the ‘first’ identifier into a list >> > just after Pkg . concat so that the whole list gets flattened and >> > everybody is happy! >> > >> > Any help appreciated. >> > >> > Thanks >> > Mike >> > >> > >> > >> > >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners Haskell-Beginners Info Page mail.haskell.org Haskell-Beginners -- The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell About Haskell-Beginners >> >> >> ------------------------------ >> >> Message: 3 >> Date: Fri, 14 Apr 2017 20:35:32 +0200 >> From: Francesco Ariis >> To: beginners at haskell.org >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: <20170414183532.GA4376 at casa.casa> >> Content-Type: text/plain; charset=utf-8 >> >> On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> > I have >> > data PackageDec = Pkg String deriving Show >> > >> > and a parser for it >> > >> > packageP :: Parser PackageDec >> > packageP = do >> > literal “package" >> > x <- identifier >> > xs <- many ((:) <$> char '.' <*> identifier) >> > return $ Pkg . concat $ (x:xs) >> > >> > so I’m parsing for this sort of string >> > “package some.sort.of.name” >> > >> > and I’m trying to rewrite the packageP parser in applicative style. As a >> > not quite correct start I have >> >> Hello Mike, >> >> I am not really sure what you are doing here? You are parsing a dot >> separated list (like.this.one) but at the end you are concatenating all >> together, why? >> Are you sure you are not wanting [String] instead of String? >> >> If so, Parsec comes with some handy parser combinators [1], maybe one of >> them could fit your bill: >> >> -- should work >> packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> '.') >> >> [1] >> https://hackage.haskell.org/package/parsec-3.1.11/docs/Text- Parsec-Combinator.html >> >> >> ------------------------------ >> >> Message: 4 >> Date: Fri, 14 Apr 2017 20:12:14 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset=utf-8 >> >> Hi David, >> >> Thanks but I tried something like that before I posted. I’ll try again >> maybe I mistyped. >> >> Mike >> > On 14 Apr 2017, at 19:17, David McBride wrote: >> > >> > Try breaking it up into pieces. There a literal "package" which is >> > dropped. There is a first identifier, then there are the rest of the >> > identifiers (a list), then those two things are combined somehow (with >> > :). >> > >> > literal "package" *> (:) <$> identifier <*> restOfIdentifiers >> > where >> > restOfIdentifiers :: Applicative f => f [String] >> > restOfIdentifiers = many ((:) <$> char '.' <*> identifier >> > >> > I have not tested this code, but it should be close to what you are >> > looking for. >> > >> > On Fri, Apr 14, 2017 at 2:02 PM, mike h >> > wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> >> >> >> packageP' :: Parser PackageDec >> >> packageP' = literal "package" >> Pkg . concat <$> many ((:) <$> char >> >> '.' <*> identifier) >> >> >> >> but I can’t see how to get the ‘first’ identifier into this sequence - >> >> i.e. the bit that corresponds to x <- identifier in the >> >> monadic version. >> >> >> >> in ghci >> >> λ-> :t many ((:) <$> char '.' <*> identifier) >> >> many ((:) <$> char '.' <*> identifier) :: Parser [[Char]] >> >> >> >> so I think that somehow I need to get the ‘first’ identifier into a >> >> list just after Pkg . concat so that the whole list gets flattened and >> >> everybody is happy! >> >> >> >> Any help appreciated. >> >> >> >> Thanks >> >> Mike >> >> >> >> >> >> >> >> >> >> >> >> _______________________________________________ >> >> 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 >> >> >> >> ------------------------------ >> >> Message: 5 >> Date: Fri, 14 Apr 2017 20:19:40 +0100 >> From: mike h >> To: The Haskell-Beginners Mailing List - Discussion of primarily >> beginner-level topics related to Haskell >> Subject: Re: [Haskell-beginners] Parsing >> Message-ID: >> Content-Type: text/plain; charset="utf-8" >> >> Hi Francesco, >> Yes, I think you are right with "Are you sure you are not wanting [String] >> instead of String?” >> >> I could use Parsec but I’m building up a parser library from first >> principles i.e. >> >> newtype Parser a = P (String -> [(a,String)]) >> >> parse :: Parser a -> String -> [(a,String)] >> parse (P p) = p >> >> and so on…. >> >> It’s just an exercise to see how far I can get. And its good fun. So maybe >> I need add another combinator or to what I already have. >> >> Thanks >> >> Mike >> >> >> > On 14 Apr 2017, at 19:35, Francesco Ariis wrote: >> > >> > On Fri, Apr 14, 2017 at 07:02:37PM +0100, mike h wrote: >> >> I have >> >> data PackageDec = Pkg String deriving Show >> >> >> >> and a parser for it >> >> >> >> packageP :: Parser PackageDec >> >> packageP = do >> >> literal “package" >> >> x <- identifier >> >> xs <- many ((:) <$> char '.' <*> identifier) >> >> return $ Pkg . concat $ (x:xs) >> >> >> >> so I’m parsing for this sort of string >> >> “package some.sort.of.name” >> >> >> >> and I’m trying to rewrite the packageP parser in applicative style. As >> >> a not quite correct start I have >> > >> > Hello Mike, >> > >> > I am not really sure what you are doing here? You are parsing a dot >> > separated list (like.this.one) but at the end you are concatenating all >> > together, why? >> > Are you sure you are not wanting [String] instead of String? >> > >> > If so, Parsec comes with some handy parser combinators [1], maybe one of >> > them could fit your bill: >> > >> > -- should work >> > packageP = literal "package" *> Pkg <$> sepEndBy1 identifier (char >> > '.') >> > >> > [1] >> > https://hackage.haskell.org/package/parsec-3.1.11/docs/Text- Parsec-Combinator.html >> > >> > _______________________________________________ >> > Beginners mailing list >> > Beginners at haskell.org > >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > >> -------------- next part -------------- >> An HTML attachment was scrubbed... >> URL: >> >> >> ------------------------------ >> >> Subject: Digest Footer >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> >> ------------------------------ >> >> End of Beginners Digest, Vol 106, Issue 7 >> ***************************************** > > > > _______________________________________________ > 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: From casual.dodo at gmail.com Wed Apr 19 16:21:58 2017 From: casual.dodo at gmail.com (Ramnath R Iyer) Date: Wed, 19 Apr 2017 16:21:58 +0000 Subject: [Haskell-beginners] Setup.hs woes Message-ID: Hello, I've been having some trouble with Setup.hs and could use some help. I'm using stack for building my project, and would like to auto-generate an HTML file as part of the build process. I'm able to specify hooks in Setup.hs to do this, but I'm running into problems. 1. I'm not sure what the "correct" or suitable paths are for publishing HTML documentation. The closest I could find was the doc dir on the install path (see below). Should the HTML be created in a built folder and later copied over to an install/dist dir? The semantics associated with each of these is not clear to me. 2. I played around with some hooks. I was able to generate the HTML file in the installation's doc dir, but it looks like that dir is only created as part of the install hook (naturally), whereas the install hook is never triggered by `stack build`. (The code below never executes if I use the instHook.) What is the right hook to use, and how? import Distribution.PackageDescription (PackageDescription) import Distribution.Simple (defaultMainWithHooks, simpleUserHooks) import Distribution.Simple.InstallDirs (InstallDirs(..), docdir) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), installDirTemplates, fromPathTemplate) import Distribution.Simple.Setup (InstallFlags) import Distribution.Simple.UserHooks (UserHooks, instHook) import System.Exit (ExitCode(..)) import System.Process (system) main :: IO () main = defaultMainWithHooks simpleUserHooks { instHook = readme } -- does not get invoked; postBuild does work, but where to put the generated file? readme :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () readme _ (LocalBuildInfo { installDirTemplates = InstallDirs { docdir = docdir' }}) _ _ = do putStrLn "Generating README.html from README.md..." exitCode <- system $ "./doc/generate " ++ (show destination) case exitCode of ExitSuccess -> return () ExitFailure _ -> fail "README.html could not be generated from README.md" return () where destination = fromPathTemplate docdir' *** (Apologies if this is a duplicate email, wasn't sure if this already got sent previously.) -------------- next part -------------- An HTML attachment was scrubbed... URL: From atrudyjane at protonmail.com Thu Apr 20 05:53:05 2017 From: atrudyjane at protonmail.com (Atrudyjane) Date: Thu, 20 Apr 2017 01:53:05 -0400 Subject: [Haskell-beginners] Traversable Instance of the Constant type Message-ID: <80UdLI1sUOnx-ehLufWkeUeOdHHrnubv8bRr3w8uuNM0TJizIPj-rb3CiCEuLFabbUw-jgYZhdYUSAuAIzBQ3AwTcj9x9a7mWSIl3L2pf_c=@protonmail.com> Pretty sure I'm getting bogged down on something simple, but how does the traverse function actually embed the Constant type in the f context passed to it? Or is it the pure defined in the f context that's being called? Thank you, Andrea newtype Constant a b = Constant { getConstant :: a } deriving (Eq, Show) instance Functor (Constant a) where fmap f (Constant a) = Constant a instance Monoid a => Applicative (Constant a) where pure a = Constant { getConstant = mempty } Constant a <*> Constant b = Constant { getConstant = a `mappend` b } instance Foldable (Constant a) where foldMap f (Constant a) = mempty instance Traversable (Constant a) where traverse f (Constant a) = pure $ Constant a λ> traverse (\x -> Just x) (Constant 1) Just (Constant {getConstant = 1}) Sent with [ProtonMail](https://protonmail.com) Secure Email. -------------- next part -------------- An HTML attachment was scrubbed... URL: From atrudyjane at protonmail.com Fri Apr 21 07:23:37 2017 From: atrudyjane at protonmail.com (Atrudyjane) Date: Fri, 21 Apr 2017 03:23:37 -0400 Subject: [Haskell-beginners] Traversable Instance of the Constant type - Think I got it Message-ID: Got confused thinking that the pure function called by Constant's traversable instance was the pure defined in Constant's applicative, which just returns Constant. Was explained to me that the type is inferred by the 'f' passed to it. If you read my OP, thank you. Regards, Andrea Sent with [ProtonMail](https://protonmail.com) Secure Email. -------------- next part -------------- An HTML attachment was scrubbed... URL: From voldermort at hotmail.com Sun Apr 23 08:21:34 2017 From: voldermort at hotmail.com (Jonathon Delgado) Date: Sun, 23 Apr 2017 08:21:34 +0000 Subject: [Haskell-beginners] Foldable for (,) Message-ID: I've seen many threads, including the one going on now, about why we need to have: length (2,3) = 1 product (2,3) = 3 sum (2,3) = 3 or (True,False) = False but the justifications all go over my head. Is there a beginner-friendly explanation for why such seemingly unintuitive operations should be allowed by default? From fa-ml at ariis.it Sun Apr 23 08:45:34 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 23 Apr 2017 10:45:34 +0200 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: <20170423084534.GA18999@casa.casa> On Sun, Apr 23, 2017 at 08:21:34AM +0000, Jonathon Delgado wrote: > I've seen many threads, including the one going on now, about why we need > to have: > > length (2,3) = 1 > product (2,3) = 3 > sum (2,3) = 3 > or (True,False) = False > > but the justifications all go over my head. Is there a beginner-friendly > explanation for why such seemingly unintuitive operations should be > allowed by default? Hello Jonathon, the proponents of `Foldable (a,)` see `(2,3)` not as a pair of 'equal' values, but as a value *and* an annotation, much like some other folks see Either as having a value (Right a) *or* an annotation (usually an error in the form of Left e). So to go back to your examples: (2,3) ^ ^ | +------------- I am the value | +--------------- I am an annotation (and since tuples arguments can be heterogeneous, I could be a String, a Bool, anything). If you agree with this paradigm, `length`, `sum` and friend become a bit less icky. I would prefer tuples to be unbiased, but this intuition helped me connect with the people on the other side of the line. Does this help? From voldermort at hotmail.com Sun Apr 23 10:06:00 2017 From: voldermort at hotmail.com (Jonathon Delgado) Date: Sun, 23 Apr 2017 10:06:00 +0000 Subject: [Haskell-beginners] Foldable for (,) Message-ID: If a tuple only has one value, why do functions for operating over sets make sense at all? I can see from your explanations why the answers could be considered correct (if a particular convention is assumed), but why does the operation make sense at all? It seems like we're asking for the length of a single value, its product, etc. Francesco Ariis wrote: > I've seen many threads, including the one going on now, about why we need > to have: > > length (2,3) = 1 > product (2,3) = 3 > sum (2,3) = 3 > or (True,False) = False > > but the justifications all go over my head. Is there a beginner-friendly > explanation for why such seemingly unintuitive operations should be > allowed by default? Hello Jonathon,     the proponents of `Foldable (a,)` see `(2,3)` not as a pair of 'equal' values, but as a value *and* an annotation, much like some other folks see Either as having a value (Right a) *or* an annotation (usually an error in the form of Left e). So to go back to your examples:     (2,3)      ^ ^      | +------------- I am the value      |      +--------------- I am an annotation (and since tuples arguments can                       be heterogeneous, I could be a String, a Bool,                       anything). If you agree with this paradigm, `length`, `sum` and friend become a bit less icky. I would prefer tuples to be unbiased, but this intuition helped me connect with the people on the other side of the line. Does this help? From fa-ml at ariis.it Sun Apr 23 10:56:38 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 23 Apr 2017 12:56:38 +0200 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: <20170423105638.GA11329@casa.casa> On Sun, Apr 23, 2017 at 10:06:00AM +0000, Jonathon Delgado wrote: > If a tuple only has one value, why do functions for operating over sets > make sense at all? I can see from your explanations why the answers could > be considered correct (if a particular convention is assumed), but why > does the operation make sense at all? It seems like we're asking for the > length of a single value, its product, etc. I can only guess: consistency. Once you create an instance of `Foldable` you instantly get some functions "for free". Among those are foldMap, foldr etc. *and* sum, length and friends. I cannot see an occurrence where writing `length (x, y)` instead of 1 makes sense. From voldermort at hotmail.com Sun Apr 23 11:08:45 2017 From: voldermort at hotmail.com (Jonathon Delgado) Date: Sun, 23 Apr 2017 11:08:45 +0000 Subject: [Haskell-beginners] Francesco Ariis Message-ID: So then the question becomes, why do tuples need Foldable if the functions it defines aren't useful? -------------- next part -------------- An HTML attachment was scrubbed... URL: From voldermort at hotmail.com Sun Apr 23 11:48:16 2017 From: voldermort at hotmail.com (Jonathon Delgado) Date: Sun, 23 Apr 2017 11:48:16 +0000 Subject: [Haskell-beginners] Foldable for (,) Message-ID: So then the question becomes, why do tuples need Foldable if the functions it defines aren't useful? From ryan.trinkle at gmail.com Sun Apr 23 12:45:59 2017 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Sun, 23 Apr 2017 08:45:59 -0400 Subject: [Haskell-beginners] Francesco Ariis In-Reply-To: References: Message-ID: I've used them plenty of times, especially in conjunction with Compose , to add annotations to things I'm traversing. On Sun, Apr 23, 2017 at 7:08 AM, Jonathon Delgado wrote: > So then the question becomes, why do tuples need Foldable if the functions > it defines aren't useful? > > _______________________________________________ > 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 doug at cs.dartmouth.edu Sun Apr 23 14:47:31 2017 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Sun, 23 Apr 2017 10:47:31 -0400 Subject: [Haskell-beginners] Foldable for (,) Message-ID: <201704231447.v3NElVMC008978@coolidge.cs.Dartmouth.EDU> > So to go back to your examples: > > (2,3) > ^ ^ > | +------------- I am the value > | > +--------------- I am an annotation (and since tuples arguments can > be heterogeneous, I could be a String, a Bool, > anything). > > If you agree with this paradigm, `length`, `sum` and friend become a > bit less icky. To me, "annotation" connotes auxiliary information--yet it will be the primary key when pairs are sorted. I would be more comfortable with the explanation if the field were referred to as an "identifier", or some similar term. Doug From tonymorris at gmail.com Mon Apr 24 00:29:49 2017 From: tonymorris at gmail.com (Tony Morris) Date: Mon, 24 Apr 2017 10:29:49 +1000 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: <06c55922-c9a5-3e16-e8c7-208efd3e49b3@gmail.com> A tuple doesn't only have one value. forall a. ((,) a) only has one value. Fortunately, Haskell has a kind system so we can easily determine what length does. > :k Foldable Foldable :: (* -> *) -> Constraint Clearly then, if we see a program (length x) where x is a tuple, then we can easily determine that this a constant value 1. For the same reason if we see (length [[1,2,3], [4,5,6]]) and ask, is the length 2 or 6? It's clearly 2; just look at the kind of Foldable. I like types, and types of types. Join me. On 23/04/17 20:06, Jonathon Delgado wrote: > If a tuple only has one value, -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 488 bytes Desc: OpenPGP digital signature URL: From michael at orlitzky.com Mon Apr 24 01:36:08 2017 From: michael at orlitzky.com (Michael Orlitzky) Date: Sun, 23 Apr 2017 21:36:08 -0400 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: <06c55922-c9a5-3e16-e8c7-208efd3e49b3@gmail.com> References: <06c55922-c9a5-3e16-e8c7-208efd3e49b3@gmail.com> Message-ID: On 04/23/2017 08:29 PM, Tony Morris wrote: > A tuple doesn't only have one value. forall a. ((,) a) only has one > value. Fortunately, Haskell has a kind system so we can easily determine > what length does. This all makes sense when you realize that Foldable is just the "Object" class from Visual Basic. There's only one sensible way to define a ToString() method on an arbitrary object; therefore it makes sense to provide that method by default, and to have it do the one thing it can do (print garbage). From voldermort at hotmail.com Mon Apr 24 06:52:54 2017 From: voldermort at hotmail.com (Jonathon Delgado) Date: Mon, 24 Apr 2017 06:52:54 +0000 Subject: [Haskell-beginners] Foldable for (,) Message-ID: Tony Morris - please could you give a (practical) example of code where the a tuple could realistically be passed to length, but you don't know what the answer will be at compile time? Michael Orlitzky - everything in .NET has to descend from Object because of it's OO design. Why does tuple have to implement Foldable if it doesn't provide any useful functions? Thank you very much everyone in this thread for helping me understand! From davidleothomas at gmail.com Mon Apr 24 08:20:10 2017 From: davidleothomas at gmail.com (David Thomas) Date: Mon, 24 Apr 2017 01:20:10 -0700 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: One thing that's been missed in this discussion is that constraints can propagate. Of course no one is wanting to pass something they know is a tuple into a function they know is length. But a function that expects something Foldable might want to know length or sum, and it might be reasonable to call that function on a tuple. On Sun, Apr 23, 2017 at 11:52 PM, Jonathon Delgado wrote: > Tony Morris - please could you give a (practical) example of code where the a tuple could realistically be passed to length, but you don't know what the answer will be at compile time? > > Michael Orlitzky - everything in .NET has to descend from Object because of it's OO design. Why does tuple have to implement Foldable if it doesn't provide any useful functions? > > Thank you very much everyone in this thread for helping me understand! > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From tmorris at tmorris.net Mon Apr 24 10:30:54 2017 From: tmorris at tmorris.net (Tony Morris) Date: Mon, 24 Apr 2017 20:30:54 +1000 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: I only know that the length of any forall a. ((,) a) is going to be one. When it is polymorphic, I don't know that it is ((,) a) although it might be at the call site, and so I don't know the length. On Mon, Apr 24, 2017 at 4:52 PM, Jonathon Delgado wrote: > Tony Morris - please could you give a (practical) example of code where > the a tuple could realistically be passed to length, but you don't know > what the answer will be at compile time? > > Michael Orlitzky - everything in .NET has to descend from Object because > of it's OO design. Why does tuple have to implement Foldable if it doesn't > provide any useful functions? > > Thank you very much everyone in this thread for helping me understand! > _______________________________________________ > 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 michael at orlitzky.com Mon Apr 24 10:44:59 2017 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 24 Apr 2017 06:44:59 -0400 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: On 04/24/2017 02:52 AM, Jonathon Delgado wrote: > > Michael Orlitzky - everything in .NET has to descend from Object > because of it's OO design. Why does tuple have to implement Foldable > if it doesn't provide any useful functions? > That was sarcasm =P I agree with you. From amindfv at gmail.com Mon Apr 24 12:34:34 2017 From: amindfv at gmail.com (amindfv at gmail.com) Date: Mon, 24 Apr 2017 07:34:34 -0500 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: References: Message-ID: <482A29C5-3474-464E-8E4E-4E6041D878C6@gmail.com> > El 24 abr 2017, a las 03:20, David Thomas escribió: > > One thing that's been missed in this discussion is that constraints > can propagate. > > Of course no one is wanting to pass something they know is a tuple > into a function they know is length. But a function that expects > something Foldable might want to know length or sum, and it might be > reasonable to call that function on a tuple. > Do you have a real-world example of a case where that's useful, and difficult to achieve in another (non-Foldable) way? Genuinely asking, so that when we talk about what's gained/lost we have something concrete to talk about. Tom > On Sun, Apr 23, 2017 at 11:52 PM, Jonathon Delgado > wrote: >> Tony Morris - please could you give a (practical) example of code where the a tuple could realistically be passed to length, but you don't know what the answer will be at compile time? >> >> Michael Orlitzky - everything in .NET has to descend from Object because of it's OO design. Why does tuple have to implement Foldable if it doesn't provide any useful functions? >> >> Thank you very much everyone in this thread for helping me understand! >> _______________________________________________ >> 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 From ryan.trinkle at gmail.com Tue Apr 25 02:48:01 2017 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Mon, 24 Apr 2017 22:48:01 -0400 Subject: [Haskell-beginners] Foldable for (,) In-Reply-To: <482A29C5-3474-464E-8E4E-4E6041D878C6@gmail.com> References: <482A29C5-3474-464E-8E4E-4E6041D878C6@gmail.com> Message-ID: I actually think the terminology may be the issue here: it's not tough to think of cases where one might need to use (sum . fmap (const 1) :: (Functor t, Foldable t) => t a -> Int), and it's also not tough to think of cases where the term "length" doesn't fit everyone's expectation for what that function does. On the other hand, there isn't really any other Foldable-based implementation of 'length' that you can write. On Mon, Apr 24, 2017 at 8:34 AM, wrote: > > > > El 24 abr 2017, a las 03:20, David Thomas > escribió: > > > > One thing that's been missed in this discussion is that constraints > > can propagate. > > > > Of course no one is wanting to pass something they know is a tuple > > into a function they know is length. But a function that expects > > something Foldable might want to know length or sum, and it might be > > reasonable to call that function on a tuple. > > > > Do you have a real-world example of a case where that's useful, and > difficult to achieve in another (non-Foldable) way? > > Genuinely asking, so that when we talk about what's gained/lost we have > something concrete to talk about. > > Tom > > > > > On Sun, Apr 23, 2017 at 11:52 PM, Jonathon Delgado > > wrote: > >> Tony Morris - please could you give a (practical) example of code where > the a tuple could realistically be passed to length, but you don't know > what the answer will be at compile time? > >> > >> Michael Orlitzky - everything in .NET has to descend from Object > because of it's OO design. Why does tuple have to implement Foldable if it > doesn't provide any useful functions? > >> > >> Thank you very much everyone in this thread for helping me understand! > >> _______________________________________________ > >> 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: From ky3 at atamo.com Tue Apr 25 10:47:24 2017 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 25 Apr 2017 17:47:24 +0700 Subject: [Haskell-beginners] Cafe first, then beginners Message-ID: Dear haskeller, Please consider writing to the haskell-cafe mailing list with your questions. Should you get an unsatisfactory response there, then retry your queries here on haskell-beginners. Here's why: Haskell-cafe has about 10x the number of eyeballs. Everyone here in haskell-beginners also reads haskell-cafe. So you'll reach the same folks here but many, many more there. This is especially helpful to you if your questions don't just deal with LYAH-level language fundamentals but overlap specialized domains like music, web dev, and infrastructure issues like OS, cabal, stack, etc. Haskell-beginners started way back when there was much traffic coinciding with an overflow of basic questions on cafe. Some folks, including old-timers, felt overwhelmed. There was a sense that the latter convos should be separated out. But seasons change, and the cafe has dried up, mostly in volume but thankfully not in subscriber count. You will do your questions great justice if you air them in a forum capable of rich and varied responses. Best, -- Kim-Ee -- -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: