From dennis.raddle at gmail.com Tue Dec 1 23:11:46 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 1 Dec 2015 15:11:46 -0800 Subject: [Haskell-beginners] help with music application Message-ID: I realize my current implementation of my music application is not pretty and I want to learn to use Haskell more effectively. My application reads a musical score exported by the typesetter Sibelius. A score is a high-level representation of music that includes structures, like grouping notes for each instrument, and directions that affect how the musuc will be played, like tempo indications, indications to gradually speed up, gradually get louder, etc. My program translates it into low-level time stamped MIDI events, which say things like "turn on this note", "turn off this note", "change the volume setting on this instrument," etc. The outline of my program is this: 1. Read the output of Sibeliusl 2. Construct a Score. A Score has several Parts (individual instruments). A part consists of a list of time stamped Chords, which represent a list of Notes that are sounded at the same time (roughly). There are expression marks in the music that apply to Chords as a whole and some apply only to Notes. Notes are the most basic sound-generating unit -- they have a pitch, a duration, some indicators of musical expression like performance techniques, a time offset (a Note may start slightly ahead or behind the time stamp on the Chord), and more. 3. Modify the Score to account for forms of musical expression and for a few strange things in the way Sibelius exports its data. Right now I process the score through a LOT of passes, maybe two dozen. Also I have given a ton of extra fields to Notes and Chords that essentially are cache or memos of the results of processing that looks for patterns. So now things are quite unwieldy.. I have two dozen extra fields between Chords and Notes, and I need to make two dozen modification passes on the Score. It's bug prone and hard to understand because the order of the passes is important and I could easily put the Score into an invalid state. So the data looks like this: The basic time stamp type is Loc, indicating a measure number and a beat within that measure. type MeasureNum = Int type MeasureBeat = Rational data Loc = Loc MeasureNum MeasureBeat type PartName = String data Score = Score ScoreRelatedData (Map PartName Part) data ScoreRelatedData = -- this is data that applies to the score as a whole, like a measure-by-measure list of tempos, time signatures, and a time map that allows the translation of Loc to a number of seconds. -- The Chords in a Part occur in time at a Loc. There can be more -- than one Chord at a Loc data Part = PartRelatedData (Map Loc [Chord]) data PartRelatedData -- data about musical expression that applies to a Part as a whole data VoiceNumber Int -- even within a single Part there can be different "voices" which means independent sequential Chords, independent in the sense they may have different volume levels, different durations, etc. data Chord = ChordRelatedData VoiceNumber [Note] data ChordRelatedData -- this includes data about the Chord as a whole, such as playback techniqes that applies to the whole Chord. It also contains a list of Notes. data Note = Note NoteRelatedData Pitch data NoteRelatedData -- this includes expression markings that apply to a Note only So there are some patterns within the Score that need to be identified before it can be translated to MIDI events. Here are some examples: 1. Tied notes. Some Notes within a Chord X are tied to a Note in the following Chord Y. That means they represent a single sound unit that should be sustained from the beginning of Chord X to the end of Chord Y. But actually the note in Chord Y can be tied to Chord Z and so on for any number of sequential Chords. When I want to find the true ending Loc of a Note I need to follow the tie chain. Some Notes in the same Chord may be tied, and others may not. 2. Double tremolos. Sometimes two sequential chords are actually supposed to played together--actually the player will rapidly alternate between the chords. When I first read the score there will be a marking on the first chord X of the double tremolo. I have to look for a Chord Y that immediately follows X, has the same VoiceNumber and the same duration, and I can infer that's the second chord in the double tremolo. Note that the timing and notes of a double tremolo, when translated to MIDI, look hardly anything like the original data -- the original data just has two Chords, but the playback will contains lots of sequential notes that are drawn from both chords. 3. Arpeggios. Sometime the notes in a chord are "rolled" -- played with the lowest note first, followed by a time-staggered playback of the other notes, going up in pitch. There might be an arpeggio marking that spans several Parts, meaning I have to look at all the parts to compute the time offsets for the notes in an arpeggio 4. problems in the data export. Sibelius has some bugs, so I need to find problems in its output and fix them by removing or altering certain Chords. And that's just the beginning. There are something like two dozen patterns that need to be identified. What I'm doing now is adding all sorts of fields to Parts, Chords, and Notes to hold memos of the results of this processing. These memo fields have to be initialized to something, like zero, or an empty Map, or whatever. Then I set them via the processing passes. This is bug-prone and unwieldy. What I am realizing is that I don't necessarily need to store every field. For isntance, consider tie chains. I don't really need to process them all ahead of time. I can follow a tie chain only in the places where I need to know the full duration of a Note. I might end up with some redundant processing, but the advantage is (1) I don't need an extra field (2) I don't have to worry about that extra field becoming invalid or remaining uninitialized. But there are some processing data that probably should be done once and memoized. For instance, I need a Map of the END LOCATION of each Chord to the Chord itself to look up certain things. That is expensive to construct. So what data do I pass to my MIDI-conversion algorithm? I could create something called ContextNote like this data ContextNote = ContextNote Score Part Chord Note Then I could write a function that converts a score to a list of context notes, and pass all of them to the conversion routine. allContextNotes :: Score -> [ContextNote] This list would have one entry for every note in the Score. Also I would probably use named fields. So I would have something like data Note = Note { nPitch :: Int , nVolume :: Int , ... } When I'm accessing the data on ContextNote, I don't want to have to type several accessor functions to get down to the Note fields. So I could do something like class HasNoteData a where pitch :: a -> Int Then instance HasNoteData ContextNote where pitch (ContextNote _ _ note) = nPitch note I could create a bunch of accessor functions like that for every field in the ContextNote. For data that should probably be computed once, I could create Memo data. Maybe I would have data ContextNote = ContextNote Memo Score Part Chord Note or something like that. So if you have read this far, thank you very much. Any suggestions welcome. D -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Tue Dec 1 23:13:21 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Tue, 1 Dec 2015 17:13:21 -0600 Subject: [Haskell-beginners] help with music application In-Reply-To: References: Message-ID: Could you post the code to a public repository? Ideally with some example input and expected output if you're that far along. On Tue, Dec 1, 2015 at 5:11 PM, Dennis Raddle wrote: > I realize my current implementation of my music application is not pretty > and I want to learn to use Haskell more effectively. > > My application reads a musical score exported by the typesetter Sibelius. > A score is a high-level representation of music that includes structures, > like grouping notes for each instrument, and directions that affect how the > musuc will be played, like tempo indications, indications to gradually > speed up, gradually get louder, etc. My program translates it into > low-level time stamped MIDI events, which say things like "turn on this > note", "turn off this note", "change the volume setting on this > instrument," etc. > > The outline of my program is this: > > 1. Read the output of Sibeliusl > > 2. Construct a Score. A Score has several Parts (individual instruments). > A part consists of a list of time stamped Chords, which represent a list of > Notes that are sounded at the same time (roughly). There are expression > marks in the music that apply to Chords as a whole and some apply only to > Notes. Notes are the most basic sound-generating unit -- they have a pitch, > a duration, some indicators of musical expression like performance > techniques, a time offset (a Note may start slightly ahead or behind the > time stamp on the Chord), and more. > > 3. Modify the Score to account for forms of musical expression and for a > few strange things in the way Sibelius exports its data. Right now I > process the score through a LOT of passes, maybe two dozen. Also I have > given a ton of extra fields to Notes and Chords that essentially are cache > or memos of the results of processing that looks for patterns. So now > things are quite unwieldy.. I have two dozen extra fields between Chords > and Notes, and I need to make two dozen modification passes on the Score. > It's bug prone and hard to understand because the order of the passes is > important and I could easily put the Score into an invalid state. > > So the data looks like this: > > The basic time stamp type is Loc, indicating a measure number and a beat > within that measure. > > type MeasureNum = Int > type MeasureBeat = Rational > data Loc = Loc MeasureNum MeasureBeat > > type PartName = String > data Score = Score ScoreRelatedData (Map PartName Part) > > data ScoreRelatedData = -- this is data that applies to the score as a > whole, like a measure-by-measure list of tempos, time signatures, and a > time map that allows the translation of Loc to a number of seconds. > > -- The Chords in a Part occur in time at a Loc. There can be more > -- than one Chord at a Loc > data Part = PartRelatedData (Map Loc [Chord]) > data PartRelatedData -- data about musical expression that applies to a > Part as a whole > > data VoiceNumber Int -- even within a single Part there can be different > "voices" which means independent sequential Chords, independent in the > sense they may have different volume levels, different durations, etc. > data Chord = ChordRelatedData VoiceNumber [Note] > data ChordRelatedData -- this includes data about the Chord as a whole, > such as playback techniqes that applies to the whole Chord. It also > contains a list of Notes. > > data Note = Note NoteRelatedData Pitch > data NoteRelatedData -- this includes expression markings that apply to a > Note only > > So there are some patterns within the Score that need to be identified > before it can be translated to MIDI events. Here are some examples: > > 1. Tied notes. Some Notes within a Chord X are tied to a Note in the > following Chord Y. That means they represent a single sound unit that > should be sustained from the beginning of Chord X to the end of Chord Y. > But actually the note in Chord Y can be tied to Chord Z and so on for any > number of sequential Chords. When I want to find the true ending Loc of a > Note I need to follow the tie chain. Some Notes in the same Chord may be > tied, and others may not. > > 2. Double tremolos. Sometimes two sequential chords are actually supposed > to played together--actually the player will rapidly alternate between the > chords. When I first read the score there will be a marking on the first > chord X of the double tremolo. I have to look for a Chord Y that > immediately follows X, has the same VoiceNumber and the same duration, and > I can infer that's the second chord in the double tremolo. Note that the > timing and notes of a double tremolo, when translated to MIDI, look hardly > anything like the original data -- the original data just has two Chords, > but the playback will contains lots of sequential notes that are drawn from > both chords. > > 3. Arpeggios. Sometime the notes in a chord are "rolled" -- played with > the lowest note first, followed by a time-staggered playback of the other > notes, going up in pitch. There might be an arpeggio marking that spans > several Parts, meaning I have to look at all the parts to compute the time > offsets for the notes in an arpeggio > > 4. problems in the data export. Sibelius has some bugs, so I need to find > problems in its output and fix them by removing or altering certain Chords. > > And that's just the beginning. There are something like two dozen patterns > that need to be identified. > > What I'm doing now is adding all sorts of fields to Parts, Chords, and > Notes to hold memos of the results of this processing. These memo fields > have to be initialized to something, like zero, or an empty Map, or > whatever. Then I set them via the processing passes. > > This is bug-prone and unwieldy. > > What I am realizing is that I don't necessarily need to store every field. > For isntance, consider tie chains. I don't really need to process them all > ahead of time. I can follow a tie chain only in the places where I need to > know the full duration of a Note. I might end up with some redundant > processing, but the advantage is > > (1) I don't need an extra field > (2) I don't have to worry about that extra field becoming invalid or > remaining uninitialized. > > But there are some processing data that probably should be done once and > memoized. For instance, I need a Map of the END LOCATION of each Chord to > the Chord itself to look up certain things. That is expensive to construct. > > So what data do I pass to my MIDI-conversion algorithm? I could create > something called ContextNote like this > > data ContextNote = ContextNote Score Part Chord Note > > Then I could write a function that converts a score to a list of context > notes, and pass all of them to the conversion routine. > > allContextNotes :: Score -> [ContextNote] > > This list would have one entry for every note in the Score. > > Also I would probably use named fields. So I would have something like > > data Note = Note > { nPitch :: Int > , nVolume :: Int > , ... > } > > When I'm accessing the data on ContextNote, I don't want to have to type > several accessor functions to get down to the Note fields. So I could do > something like > > class HasNoteData a where > pitch :: a -> Int > > Then > > instance HasNoteData ContextNote where > pitch (ContextNote _ _ note) = nPitch note > > I could create a bunch of accessor functions like that for every field in > the ContextNote. > > For data that should probably be computed once, I could create Memo data. > Maybe I would have > > data ContextNote = ContextNote Memo Score Part Chord Note > > or something like that. > > So if you have read this far, thank you very much. Any suggestions welcome. > > D > > > > > > > > > > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Tue Dec 1 23:22:53 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 1 Dec 2015 15:22:53 -0800 Subject: [Haskell-beginners] help with music application In-Reply-To: References: Message-ID: On Tue, Dec 1, 2015 at 3:13 PM, Christopher Allen wrote: > Could you post the code to a public repository? Ideally with some example > input and expected output if you're that far along. > > It's running fine and mostly complete right now, so just as an aside this is a rewrite project to make it cleaner and easily to modify in the future. But about posting it, it's pretty enormous, many files grouped into about eight modules. What do you recommend I do? Create a BitBucket repository? D -------------- next part -------------- An HTML attachment was scrubbed... URL: From mmartin4242 at gmail.com Tue Dec 1 23:30:00 2015 From: mmartin4242 at gmail.com (Michael Martin) Date: Tue, 1 Dec 2015 17:30:00 -0600 Subject: [Haskell-beginners] help with music application In-Reply-To: References: Message-ID: Github On Dec 1, 2015 5:23 PM, "Dennis Raddle" wrote: > > > On Tue, Dec 1, 2015 at 3:13 PM, Christopher Allen > wrote: > >> Could you post the code to a public repository? Ideally with some example >> input and expected output if you're that far along. >> >> > > It's running fine and mostly complete right now, so just as an aside this > is a rewrite project to make it cleaner and easily to modify in the future. > But about posting it, it's pretty enormous, many files grouped into about > eight modules. What do you recommend I do? Create a BitBucket repository? > > D > > > > > _______________________________________________ > 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 cma at bitemyapp.com Tue Dec 1 23:37:24 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Tue, 1 Dec 2015 17:37:24 -0600 Subject: [Haskell-beginners] help with music application In-Reply-To: References: Message-ID: Github or Bitbucket are fine, according to your preference. Some people might complain if it's not Github since there's more people there. I personally don't care. On Tue, Dec 1, 2015 at 5:22 PM, Dennis Raddle wrote: > > > On Tue, Dec 1, 2015 at 3:13 PM, Christopher Allen > wrote: > >> Could you post the code to a public repository? Ideally with some example >> input and expected output if you're that far along. >> >> > > It's running fine and mostly complete right now, so just as an aside this > is a rewrite project to make it cleaner and easily to modify in the future. > But about posting it, it's pretty enormous, many files grouped into about > eight modules. What do you recommend I do? Create a BitBucket repository? > > D > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Wed Dec 2 00:05:57 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 1 Dec 2015 16:05:57 -0800 Subject: [Haskell-beginners] help with music application In-Reply-To: <888D1DCB-67C1-44F4-B1B8-E1C0E80E2F66@gmail.com> References: <888D1DCB-67C1-44F4-B1B8-E1C0E80E2F66@gmail.com> Message-ID: On Tue, Dec 1, 2015 at 3:24 PM, Andrew Bernard wrote: > Hi Dennis, > > This is a massively difficult and long task, fun of musical complexity. > Are you aware of lilypond, the open source engraving program? It can export > to MIDI and has been developed for over twenty years by hundreds of people. > It is not written in Haskell, but C++ and Scheme principally. > > Not meaning to disparage your work in any way, but it does seem you are > reinventing the wheel, and a rather big and complicated wheel. I am sure it > is an interesting exercise, and perhaps Sibelius does not play MIDI ? I use > lilypond so I do not know. > > Help you don?t mind me letting you know. > > Hi Andrew, I'm copying the list on this message because these are some relevant questions to the task as a whole. I am aware of LilyPond, and I also own two commercial programs, Finale and Sibelius. Here are the reasons I am reinventing the wheel. 1. I want to experiment with algorithms that introduce "human expression" into the playback. Finale, Sibelius, and Lilypond can export to MIDI, but the results sound mechanical and lifeless -- to my picky ears, anyway. (many composers don't mind). Actually, Sibelius claims to use "human expression" but my point is that I want to experiment with my own algorithms and I want to be able to get into the source code to implement and modify things. 2. Trying to get the musical data into my program via exporting from Sibelius or Finale to MIDI won't work. MIDI is poor way to express musical structures, and cannot represent symbols and expressive marks in the score. 3. Here's one of the most significant factors. I didn't mention anything yet about what happens to the MIDI after I produce it. What happens is that I feed it to a "software synthesizer." This is a program that produces sound, by simulating or playing little bits of prerecorded notes. Here's what is a big deal -- there is hardly any standard for how software synthesizers respond to MIDI, especially all the control events. And every software synthesizer has custom capabilities. Finale and Sibelius claim to be able to do special controlling of the most popular synthesizers, but their capability is limited to one or two at most, and it actually hard to control (and maybe even buggy). I own three very good synthesizers, and two of them have controls that Sibelius and Finale don't understand in the slightest. I need many of these controls for my "human playback" algorithms. 4. Last but not least, I needed a personal project to learn Haskell (I have not and never will use it for work) so this is fun, and when you consider how it lets me experiment and use non-standard synthesizers, really quite practical in the end. 5. Also, I can limit my functionality to what I need. The big programs like LilyPond need to handle all sorts of instruments and notations. Say, guitar. That's a whole project in itself. But I'm not using guitar. I'm only using maybe 20% of the types of symbols and expressive marks that the big programs handle. D -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Wed Dec 2 00:12:50 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Tue, 1 Dec 2015 16:12:50 -0800 Subject: [Haskell-beginners] More type errors I'm having trouble with Message-ID: I'm continuing my now-and-then exploration of Haskell. I'm getting a new crop of type errors that I'm pulling my hair out over. The errors I'm getting are: $ make below cmd output started 2015 Tue Dec 01 04:05:17 PM PST # --make will go out and find what to build ghc -Wall --make -o dph dph.hs Split0.hs [1 of 3] Compiling Split0 ( Split0.hs, Split0.o ) [2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o ) [3 of 3] Compiling Main ( dph.hs, dph.o ) dph.hs:13:13: Couldn't match type `IO' with `(,) (IO String)' Expected type: (IO String, String) Actual type: IO String In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String In the expression: do { hash <- prefix_md5 filename :: IO String; (hash, filename) } In an equation for `do_prefix_hash': do_prefix_hash filename = do { hash <- prefix_md5 filename :: IO String; (hash, filename) } dph.hs:14:6: Couldn't match type `[Char]' with `IO String' Expected type: IO String Actual type: String In the expression: hash In a stmt of a 'do' block: (hash, filename) In the expression: do { hash <- prefix_md5 filename :: IO String; (hash, filename) } dph.hs:24:23: Couldn't match type `[]' with `IO' Expected type: IO (IO String, String) Actual type: [(IO String, String)] In a stmt of a 'do' block: io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)] In the expression: do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; hash_tuples <- sequence io_hash_tuples :: [(String, String)]; .... } In an equation for `main': main = do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; .... } dph.hs:25:20: Couldn't match type `[a0]' with `(String, String)' Expected type: [(String, String)] Actual type: [[a0]] In the return type of a call of `sequence' In a stmt of a 'do' block: hash_tuples <- sequence io_hash_tuples :: [(String, String)] In the expression: do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; hash_tuples <- sequence io_hash_tuples :: [(String, String)]; .... } dph.hs:25:20: Couldn't match type `[]' with `IO' Expected type: IO (String, String) Actual type: [(String, String)] In a stmt of a 'do' block: hash_tuples <- sequence io_hash_tuples :: [(String, String)] In the expression: do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; hash_tuples <- sequence io_hash_tuples :: [(String, String)]; .... } In an equation for `main': main = do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; .... } dph.hs:25:29: Couldn't match expected type `[[a0]]' with actual type `(IO String, String)' In the first argument of `sequence', namely `io_hash_tuples' In a stmt of a 'do' block: hash_tuples <- sequence io_hash_tuples :: [(String, String)] In the expression: do { buffer <- (hGetContents stdin) :: IO String; let filenames = ...; io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]; hash_tuples <- sequence io_hash_tuples :: [(String, String)]; .... } dph.hs:26:39: Couldn't match expected type `[(String, String)]' with actual type `(String, String)' In the second argument of `map', namely `hash_tuples' In the expression: map tuple_to_string hash_tuples :: [String] In an equation for `strings': strings = map tuple_to_string hash_tuples :: [String] make: *** [dph] Error 1 above cmd output done 2015 Tue Dec 01 04:05:18 PM PST dph.hs looks like: import Md5s import Split0 import System.IO get_filenames :: String -> [String] get_filenames buffer = do -- Let's hope this doesn't give locale-related roundtrip problems. Split0.split0 '\0' buffer :: [String] do_prefix_hash :: String -> (IO String, String) do_prefix_hash filename = do hash <- Md5s.prefix_md5 filename :: (IO String) (hash, filename) tuple_to_string :: (String, String) -> String tuple_to_string (first, second) = do (show first) ++ " " ++ (show second) main :: IO () main = do buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String let filenames = (get_filenames buffer) :: [String] io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)] hash_tuples <- sequence io_hash_tuples :: [(String, String)] let strings = map tuple_to_string hash_tuples :: [String] mapM_ putStrLn strings And Md5s.hs looks like: module Md5s where import qualified System.IO import qualified Text.Printf -- cabal install cryptohash import qualified Crypto.Hash.MD5 import qualified Data.ByteString import qualified Data.ByteString.Lazy -- http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation byte_string_to_hex :: Data.ByteString.ByteString -> String byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . Data.ByteString.unpack prefix_md5 :: String -> IO String prefix_md5 filename = do let prefix_length = 1024 file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle data_read <- Data.ByteString.hGet file prefix_length :: IO Data.ByteString.ByteString _ <- System.IO.hClose file let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx let hasher2 = Crypto.Hash.MD5.update hasher data_read :: Crypto.Hash.MD5.Ctx let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: Data.ByteString.ByteString let hex_digest = byte_string_to_hex binary_digest :: String return hex_digest :: IO String full_md5 :: String -> IO String full_md5 filename = do file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle data_read <- Data.ByteString.Lazy.hGetContents file :: IO Data.ByteString.Lazy.ByteString let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: Data.ByteString.ByteString let hex_digest = byte_string_to_hex binary_digest :: String -- Does this get closed for us later? -- strace shows the file getting closed without our explicit close. -- _ <- System.IO.hClose file return hex_digest :: IO String It might be easier to view these at http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/ , so the line numbers are precise. What is the deal? Can anyone tell me what should be running through my head to fix this kind of problem on my own in the future? Thanks! -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Wed Dec 2 03:30:57 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 1 Dec 2015 19:30:57 -0800 Subject: [Haskell-beginners] help with music application In-Reply-To: References: <888D1DCB-67C1-44F4-B1B8-E1C0E80E2F66@gmail.com> Message-ID: On Tue, Dec 1, 2015 at 4:05 PM, Dennis Raddle wrote: > > > 5. Also, I can limit my functionality to what I need. The big programs > like LilyPond need to handle all sorts of instruments and notations. Say, > guitar. That's a whole project in itself. But I'm not using guitar. I'm > only using maybe 20% of the types of symbols and expressive marks that the > big programs handle. > > Oh, in case it wasn't clear, I don't handle typesetting at all... I'm still using Sibelius or Finale to do that. I can export via MusicXML rather than MIDI, which gets me most of the symbols on the score and organizes the structure of the music. My program is MusicXML -> MIDI, via custom algorithms. D -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon.jakobi at googlemail.com Wed Dec 2 03:47:48 2015 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Wed, 2 Dec 2015 04:47:48 +0100 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: Hi Dan, I'm having a hard time understanding those error messages too. It seems to me that part of the problem is that GHC is confused by some incorrect type annotations of yours. I suggest that you delete or at least comment out your own type annotations and then either work with the hopefully simpler error-messages from GHC or use the `:load` and `:type` commands in ghci to discover the inferred types for your functions. Depending on how close the inferred type is to the intended type, you may have to adjust the definitions. Also note that you sometimes incorrectly and unnecessarily use do-notation in "non-monadic"/plain functions, for example in tuple_to_string and get_filenames. You could also consider following a book or a course until you feel more comfortable trying things on your own: Take a look at learnyouahaskell.com or github.com/bitemyapp/learnhaskell. Good luck! Simon 2015-12-02 1:12 GMT+01:00, Dan Stromberg : > I'm continuing my now-and-then exploration of Haskell. > > I'm getting a new crop of type errors that I'm pulling my hair out over. > > The errors I'm getting are: > > $ make > below cmd output started 2015 Tue Dec 01 04:05:17 PM PST > # --make will go out and find what to build > ghc -Wall --make -o dph dph.hs Split0.hs > [1 of 3] Compiling Split0 ( Split0.hs, Split0.o ) > [2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o ) > [3 of 3] Compiling Main ( dph.hs, dph.o ) > > dph.hs:13:13: > Couldn't match type `IO' with `(,) (IO String)' > Expected type: (IO String, String) > Actual type: IO String > In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String > In the expression: > do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > In an equation for `do_prefix_hash': > do_prefix_hash filename > = do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > > dph.hs:14:6: > Couldn't match type `[Char]' with `IO String' > Expected type: IO String > Actual type: String > In the expression: hash > In a stmt of a 'do' block: (hash, filename) > In the expression: > do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > > dph.hs:24:23: > Couldn't match type `[]' with `IO' > Expected type: IO (IO String, String) > Actual type: [(IO String, String)] > In a stmt of a 'do' block: > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > In an equation for `main': > main > = do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > .... } > > dph.hs:25:20: > Couldn't match type `[a0]' with `(String, String)' > Expected type: [(String, String)] > Actual type: [[a0]] > In the return type of a call of `sequence' > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > > dph.hs:25:20: > Couldn't match type `[]' with `IO' > Expected type: IO (String, String) > Actual type: [(String, String)] > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > In an equation for `main': > main > = do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > .... } > > dph.hs:25:29: > Couldn't match expected type `[[a0]]' > with actual type `(IO String, String)' > In the first argument of `sequence', namely `io_hash_tuples' > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > > dph.hs:26:39: > Couldn't match expected type `[(String, String)]' > with actual type `(String, String)' > In the second argument of `map', namely `hash_tuples' > In the expression: map tuple_to_string hash_tuples :: [String] > In an equation for `strings': > strings = map tuple_to_string hash_tuples :: [String] > make: *** [dph] Error 1 > above cmd output done 2015 Tue Dec 01 04:05:18 PM PST > > > dph.hs looks like: > import Md5s > import Split0 > import System.IO > > get_filenames :: String -> [String] > get_filenames buffer = do > -- Let's hope this doesn't give locale-related roundtrip problems. > Split0.split0 '\0' buffer :: [String] > > do_prefix_hash :: String -> (IO String, String) > do_prefix_hash filename = do > hash <- Md5s.prefix_md5 filename :: (IO String) > (hash, filename) > > tuple_to_string :: (String, String) -> String > tuple_to_string (first, second) = do > (show first) ++ " " ++ (show second) > > main :: IO () > main = do > buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String > let filenames = (get_filenames buffer) :: [String] > io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)] > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > let strings = map tuple_to_string hash_tuples :: [String] > mapM_ putStrLn strings > > > And Md5s.hs looks like: > module Md5s where > > import qualified System.IO > import qualified Text.Printf > -- cabal install cryptohash > import qualified Crypto.Hash.MD5 > import qualified Data.ByteString > import qualified Data.ByteString.Lazy > > -- > http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation > byte_string_to_hex :: Data.ByteString.ByteString -> String > byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . > Data.ByteString.unpack > > prefix_md5 :: String -> IO String > prefix_md5 filename = do > let prefix_length = 1024 > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > System.IO.Handle > data_read <- Data.ByteString.hGet file prefix_length :: IO > Data.ByteString.ByteString > _ <- System.IO.hClose file > let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx > let hasher2 = Crypto.Hash.MD5.update hasher data_read :: > Crypto.Hash.MD5.Ctx > let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: > Data.ByteString.ByteString > let hex_digest = byte_string_to_hex binary_digest :: String > return hex_digest :: IO String > > full_md5 :: String -> IO String > full_md5 filename = do > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > System.IO.Handle > data_read <- Data.ByteString.Lazy.hGetContents file :: IO > Data.ByteString.Lazy.ByteString > let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: > Data.ByteString.ByteString > let hex_digest = byte_string_to_hex binary_digest :: String > -- Does this get closed for us later? > -- strace shows the file getting closed without our explicit close. > -- _ <- System.IO.hClose file > return hex_digest :: IO String > > > It might be easier to view these at > http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/ > , so the line numbers are precise. > > What is the deal? > > Can anyone tell me what should be running through my head to fix this kind > of problem on my own in the future? > > Thanks! > > -- > Dan Stromberg > From toad3k at gmail.com Wed Dec 2 13:05:31 2015 From: toad3k at gmail.com (David McBride) Date: Wed, 2 Dec 2015 08:05:31 -0500 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: You seem to be having some problems understanding how Monads and do notation work. do_prefix_hash :: String -> (IO String, String) do_prefix_hash filename = do hash <- Md5s.prefix_md5 filename :: (IO String) (hash, filename) The above is ill typed. When you open with a do, from that point on the type will be Monad m => String -> m Something. But what you intended to return is a tuple, which is not an instance of monad. Don't use do in this case, just return a tuple. do_prefix_hash :: String -> (IO String, String) do_prefix_hash filename = (Md5s.prefix_md5 filename, filename) Just look closely at what the error is telling you. Is it expecting a type that you told it it returns but it is detecting that your code would return something else. On Tue, Dec 1, 2015 at 7:12 PM, Dan Stromberg wrote: > > I'm continuing my now-and-then exploration of Haskell. > > I'm getting a new crop of type errors that I'm pulling my hair out over. > > The errors I'm getting are: > > $ make > below cmd output started 2015 Tue Dec 01 04:05:17 PM PST > # --make will go out and find what to build > ghc -Wall --make -o dph dph.hs Split0.hs > [1 of 3] Compiling Split0 ( Split0.hs, Split0.o ) > [2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o ) > [3 of 3] Compiling Main ( dph.hs, dph.o ) > > dph.hs:13:13: > Couldn't match type `IO' with `(,) (IO String)' > Expected type: (IO String, String) > Actual type: IO String > In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String > In the expression: > do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > In an equation for `do_prefix_hash': > do_prefix_hash filename > = do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > > dph.hs:14:6: > Couldn't match type `[Char]' with `IO String' > Expected type: IO String > Actual type: String > In the expression: hash > In a stmt of a 'do' block: (hash, filename) > In the expression: > do { hash <- prefix_md5 filename :: IO String; > (hash, filename) } > > dph.hs:24:23: > Couldn't match type `[]' with `IO' > Expected type: IO (IO String, String) > Actual type: [(IO String, String)] > In a stmt of a 'do' block: > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > In an equation for `main': > main > = do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > .... } > > dph.hs:25:20: > Couldn't match type `[a0]' with `(String, String)' > Expected type: [(String, String)] > Actual type: [[a0]] > In the return type of a call of `sequence' > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > > dph.hs:25:20: > Couldn't match type `[]' with `IO' > Expected type: IO (String, String) > Actual type: [(String, String)] > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > In an equation for `main': > main > = do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > .... } > > dph.hs:25:29: > Couldn't match expected type `[[a0]]' > with actual type `(IO String, String)' > In the first argument of `sequence', namely `io_hash_tuples' > In a stmt of a 'do' block: > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > In the expression: > do { buffer <- (hGetContents stdin) :: IO String; > let filenames = ...; > io_hash_tuples <- map do_prefix_hash filenames :: > [(IO String, String)]; > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > .... } > > dph.hs:26:39: > Couldn't match expected type `[(String, String)]' > with actual type `(String, String)' > In the second argument of `map', namely `hash_tuples' > In the expression: map tuple_to_string hash_tuples :: [String] > In an equation for `strings': > strings = map tuple_to_string hash_tuples :: [String] > make: *** [dph] Error 1 > above cmd output done 2015 Tue Dec 01 04:05:18 PM PST > > > dph.hs looks like: > import Md5s > import Split0 > import System.IO > > get_filenames :: String -> [String] > get_filenames buffer = do > -- Let's hope this doesn't give locale-related roundtrip problems. > Split0.split0 '\0' buffer :: [String] > > do_prefix_hash :: String -> (IO String, String) > do_prefix_hash filename = do > hash <- Md5s.prefix_md5 filename :: (IO String) > (hash, filename) > > tuple_to_string :: (String, String) -> String > tuple_to_string (first, second) = do > (show first) ++ " " ++ (show second) > > main :: IO () > main = do > buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String > let filenames = (get_filenames buffer) :: [String] > io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)] > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > let strings = map tuple_to_string hash_tuples :: [String] > mapM_ putStrLn strings > > > And Md5s.hs looks like: > module Md5s where > > import qualified System.IO > import qualified Text.Printf > -- cabal install cryptohash > import qualified Crypto.Hash.MD5 > import qualified Data.ByteString > import qualified Data.ByteString.Lazy > > -- > http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation > byte_string_to_hex :: Data.ByteString.ByteString -> String > byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . > Data.ByteString.unpack > > prefix_md5 :: String -> IO String > prefix_md5 filename = do > let prefix_length = 1024 > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > System.IO.Handle > data_read <- Data.ByteString.hGet file prefix_length :: IO > Data.ByteString.ByteString > _ <- System.IO.hClose file > let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx > let hasher2 = Crypto.Hash.MD5.update hasher data_read :: > Crypto.Hash.MD5.Ctx > let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: > Data.ByteString.ByteString > let hex_digest = byte_string_to_hex binary_digest :: String > return hex_digest :: IO String > > full_md5 :: String -> IO String > full_md5 filename = do > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > System.IO.Handle > data_read <- Data.ByteString.Lazy.hGetContents file :: IO > Data.ByteString.Lazy.ByteString > let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: > Data.ByteString.ByteString > let hex_digest = byte_string_to_hex binary_digest :: String > -- Does this get closed for us later? > -- strace shows the file getting closed without our explicit close. > -- _ <- System.IO.hClose file > return hex_digest :: IO String > > > It might be easier to view these at > http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/ > , so the line numbers are precise. > > What is the deal? > > Can anyone tell me what should be running through my head to fix this kind > of problem on my own in the future? > > Thanks! > > -- > Dan Stromberg > > _______________________________________________ > 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 galeonet at tiscali.it Thu Dec 3 11:54:19 2015 From: galeonet at tiscali.it (galeonet at tiscali.it) Date: Thu, 03 Dec 2015 12:54:19 +0100 Subject: [Haskell-beginners] cannot install system.filesystem Message-ID: <60ea4ffc7379cba84024d427551823f4@tiscali.it> Hello, what's wrong (see below)???? Thank you in advance, Maurizio C:Documents and Settingsxxx1>cabal install FileSystem Resolving dependencies... cabal: Could not resolve dependencies: trying: FileSystem-1.0.0 (user goal) next goal: bytestring (dependency of FileSystem-1.0.0) rejecting: bytestring-0.10.6.0/installed-3a6..., 0.10.6.0, 0.10.4.1, 0.10.4.0, 0.10.2.0, 0.10.0.2, 0.10.0.1, 0.10.0.0 (conflict: FileSystem => bytestring==0.9.*) trying: bytestring-0.9.2.1 trying: directory-1.2.2.0/installed-678... (dependency of FileSystem-1.0.0) next goal: Win32 (dependency of directory-1.2.2.0/installed-678...) rejecting: Win32-2.3.1.0/installed-071... (conflict: bytestring==0.9.2.1, Win32 => bytestring==0.10.6.0/installed-3a6...) rejecting: Win32-2.3.1.0, 2.3.0.2, 2.3.0.1, 2.3.0.0, 2.2.2.0, 2.2.1.0, 2.2.0.2, 2.2.0.1, 2.2.0.0, 2.1.0.0, 2.1 (conflict: directory => Win32==2.3.1.0/installed-071...) Dependency tree exhaustively searched. C:Documents and Settingsxxx1>cabal install FileSystem --allow-newer Resolving dependencies... Downloading FileSystem-1.0.0... Configuring FileSystem-1.0.0... Building FileSystem-1.0.0... Preprocessing library FileSystem-1.0.0... [1 of 9] Compiling System.FileSystem.Utils ( SystemFileSystemUtils.hs, distbu ildSystemFileSystemUtils.o ) [2 of 9] Compiling System.FileSystem.Types ( SystemFileSystemTypes.hs, distbu ildSystemFileSystemTypes.o ) SystemFileSystemTypes.hs:123:82: No instance for (Applicative (FST m)) arising from the 'deriving' clause of a data type declaration Possible fix: use a standalone 'deriving instance' declaration, so you can specify the instance context yourself When deriving the instance for (Monad (FST m)) SystemFileSystemTypes.hs:123:89: No instance for (Applicative (FST m)) arising from the 'deriving' clause of a data type declaration Possible fix: use a standalone 'deriving instance' declaration, so you can specify the instance context yourself When deriving the instance for (MonadIO (FST m)) Failed to install FileSystem-1.0.0 cabal: Error: some packages failed to install: FileSystem-1.0.0 failed during the building phase. The exception was: ExitFailure 1 Connetti gratis il mondo con la nuova indoona: hai la chat, le chiamate, le video chiamate e persino le chiamate di gruppo. E chiami gratis anche i numeri fissi e mobili nel mondo! Scarica subito l?app Vai su https://www.indoona.com/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From akaberto at gmail.com Thu Dec 3 12:04:37 2015 From: akaberto at gmail.com (akash g) Date: Thu, 3 Dec 2015 17:34:37 +0530 Subject: [Haskell-beginners] cannot install system.filesystem In-Reply-To: <60ea4ffc7379cba84024d427551823f4@tiscali.it> References: <60ea4ffc7379cba84024d427551823f4@tiscali.it> Message-ID: You are probably using GHC 7.10. With this, you will need any data type to be an instance of applicative and functor for it to be an instance of Monad. However, I don't see a version 1.0.0 for said package. See the below link for more information. You might try your luck asking the maintainer for a fix for this. Or you can copy this locally, make those changes yourself and see how it goes. https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10 On Thu, Dec 3, 2015 at 5:24 PM, wrote: > > Hello, > what's wrong (see below)???? > Thank you in advance, > Maurizio > > C:\Documents and Settings\xxx1>cabal install FileSystem > Resolving dependencies... > cabal: Could not resolve dependencies: > trying: FileSystem-1.0.0 (user goal) > next goal: bytestring (dependency of FileSystem-1.0.0) > rejecting: bytestring-0.10.6.0/installed-3a6..., 0.10.6.0, 0.10.4.1, > 0.10.4.0, > 0.10.2.0, 0.10.0.2, 0.10.0.1, 0.10.0.0 (conflict: FileSystem => > bytestring==0.9.*) > trying: bytestring-0.9.2.1 > trying: directory-1.2.2.0/installed-678... (dependency of FileSystem-1.0.0) > next goal: Win32 (dependency of directory-1.2.2.0/installed-678...) > rejecting: Win32-2.3.1.0/installed-071... (conflict: bytestring==0.9.2.1, > Win32 => bytestring==0.10.6.0/installed-3a6...) > rejecting: Win32-2.3.1.0, 2.3.0.2, 2.3.0.1, 2.3.0.0, 2.2.2.0, 2.2.1.0, > 2.2.0.2, 2.2.0.1, 2.2.0.0, 2.1.0.0, 2.1 (conflict: directory => > Win32==2.3.1.0/installed-071...) > Dependency tree exhaustively searched. > > C:\Documents and Settings\xxx1>cabal install FileSystem --allow-newer > Resolving dependencies... > Downloading FileSystem-1.0.0... > Configuring FileSystem-1.0.0... > Building FileSystem-1.0.0... > Preprocessing library FileSystem-1.0.0... > [1 of 9] Compiling System.FileSystem.Utils ( System\FileSystem\Utils.hs, > dist\bu > ild\System\FileSystem\Utils.o ) > [2 of 9] Compiling System.FileSystem.Types ( System\FileSystem\Types.hs, > dist\bu > ild\System\FileSystem\Types.o ) > > System\FileSystem\Types.hs:123:82: > No instance for (Applicative (FST m)) > arising from the 'deriving' clause of a data type declaration > Possible fix: > use a standalone 'deriving instance' declaration, > so you can specify the instance context yourself > When deriving the instance for (Monad (FST m)) > > System\FileSystem\Types.hs:123:89: > No instance for (Applicative (FST m)) > arising from the 'deriving' clause of a data type declaration > Possible fix: > use a standalone 'deriving instance' declaration, > so you can specify the instance context yourself > When deriving the instance for (MonadIO (FST m)) > Failed to install FileSystem-1.0.0 > cabal: Error: some packages failed to install: > FileSystem-1.0.0 failed during the building phase. The exception was: > ExitFailure 1 > > > > > Connetti gratis il mondo con la nuova indoona: hai la chat, le chiamate, > le video chiamate e persino le chiamate di gruppo. > E chiami gratis anche i numeri fissi e mobili nel mondo! > Scarica subito l?app Vai su https://www.indoona.com/ > > > _______________________________________________ > 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 strombrg at gmail.com Thu Dec 3 21:49:48 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Thu, 3 Dec 2015 13:49:48 -0800 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: Thank you! You're correct; I had been thinking of do notation as a "multistatement" thing rather than as a monad thing. On Wed, Dec 2, 2015 at 5:05 AM, David McBride wrote: > You seem to be having some problems understanding how Monads and do > notation work. > > do_prefix_hash :: String -> (IO String, String) > do_prefix_hash filename = do > hash <- Md5s.prefix_md5 filename :: (IO String) > (hash, filename) > > The above is ill typed. When you open with a do, from that point on the > type will be Monad m => String -> m Something. But what you intended to > return is a tuple, which is not an instance of monad. Don't use do in this > case, just return a tuple. > > do_prefix_hash :: String -> (IO String, String) > do_prefix_hash filename = (Md5s.prefix_md5 filename, filename) > > Just look closely at what the error is telling you. Is it expecting a > type that you told it it returns but it is detecting that your code would > return something else. > > > On Tue, Dec 1, 2015 at 7:12 PM, Dan Stromberg wrote: > >> >> I'm continuing my now-and-then exploration of Haskell. >> >> I'm getting a new crop of type errors that I'm pulling my hair out over. >> >> The errors I'm getting are: >> >> $ make >> below cmd output started 2015 Tue Dec 01 04:05:17 PM PST >> # --make will go out and find what to build >> ghc -Wall --make -o dph dph.hs Split0.hs >> [1 of 3] Compiling Split0 ( Split0.hs, Split0.o ) >> [2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o ) >> [3 of 3] Compiling Main ( dph.hs, dph.o ) >> >> dph.hs:13:13: >> Couldn't match type `IO' with `(,) (IO String)' >> Expected type: (IO String, String) >> Actual type: IO String >> In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String >> In the expression: >> do { hash <- prefix_md5 filename :: IO String; >> (hash, filename) } >> In an equation for `do_prefix_hash': >> do_prefix_hash filename >> = do { hash <- prefix_md5 filename :: IO String; >> (hash, filename) } >> >> dph.hs:14:6: >> Couldn't match type `[Char]' with `IO String' >> Expected type: IO String >> Actual type: String >> In the expression: hash >> In a stmt of a 'do' block: (hash, filename) >> In the expression: >> do { hash <- prefix_md5 filename :: IO String; >> (hash, filename) } >> >> dph.hs:24:23: >> Couldn't match type `[]' with `IO' >> Expected type: IO (IO String, String) >> Actual type: [(IO String, String)] >> In a stmt of a 'do' block: >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)] >> In the expression: >> do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> hash_tuples <- sequence io_hash_tuples :: [(String, String)]; >> .... } >> In an equation for `main': >> main >> = do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> .... } >> >> dph.hs:25:20: >> Couldn't match type `[a0]' with `(String, String)' >> Expected type: [(String, String)] >> Actual type: [[a0]] >> In the return type of a call of `sequence' >> In a stmt of a 'do' block: >> hash_tuples <- sequence io_hash_tuples :: [(String, String)] >> In the expression: >> do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> hash_tuples <- sequence io_hash_tuples :: [(String, String)]; >> .... } >> >> dph.hs:25:20: >> Couldn't match type `[]' with `IO' >> Expected type: IO (String, String) >> Actual type: [(String, String)] >> In a stmt of a 'do' block: >> hash_tuples <- sequence io_hash_tuples :: [(String, String)] >> In the expression: >> do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> hash_tuples <- sequence io_hash_tuples :: [(String, String)]; >> .... } >> In an equation for `main': >> main >> = do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> .... } >> >> dph.hs:25:29: >> Couldn't match expected type `[[a0]]' >> with actual type `(IO String, String)' >> In the first argument of `sequence', namely `io_hash_tuples' >> In a stmt of a 'do' block: >> hash_tuples <- sequence io_hash_tuples :: [(String, String)] >> In the expression: >> do { buffer <- (hGetContents stdin) :: IO String; >> let filenames = ...; >> io_hash_tuples <- map do_prefix_hash filenames :: >> [(IO String, String)]; >> hash_tuples <- sequence io_hash_tuples :: [(String, String)]; >> .... } >> >> dph.hs:26:39: >> Couldn't match expected type `[(String, String)]' >> with actual type `(String, String)' >> In the second argument of `map', namely `hash_tuples' >> In the expression: map tuple_to_string hash_tuples :: [String] >> In an equation for `strings': >> strings = map tuple_to_string hash_tuples :: [String] >> make: *** [dph] Error 1 >> above cmd output done 2015 Tue Dec 01 04:05:18 PM PST >> >> >> dph.hs looks like: >> import Md5s >> import Split0 >> import System.IO >> >> get_filenames :: String -> [String] >> get_filenames buffer = do >> -- Let's hope this doesn't give locale-related roundtrip problems. >> Split0.split0 '\0' buffer :: [String] >> >> do_prefix_hash :: String -> (IO String, String) >> do_prefix_hash filename = do >> hash <- Md5s.prefix_md5 filename :: (IO String) >> (hash, filename) >> >> tuple_to_string :: (String, String) -> String >> tuple_to_string (first, second) = do >> (show first) ++ " " ++ (show second) >> >> main :: IO () >> main = do >> buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String >> let filenames = (get_filenames buffer) :: [String] >> io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, >> String)] >> hash_tuples <- sequence io_hash_tuples :: [(String, String)] >> let strings = map tuple_to_string hash_tuples :: [String] >> mapM_ putStrLn strings >> >> >> And Md5s.hs looks like: >> module Md5s where >> >> import qualified System.IO >> import qualified Text.Printf >> -- cabal install cryptohash >> import qualified Crypto.Hash.MD5 >> import qualified Data.ByteString >> import qualified Data.ByteString.Lazy >> >> -- >> http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation >> byte_string_to_hex :: Data.ByteString.ByteString -> String >> byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . >> Data.ByteString.unpack >> >> prefix_md5 :: String -> IO String >> prefix_md5 filename = do >> let prefix_length = 1024 >> file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO >> System.IO.Handle >> data_read <- Data.ByteString.hGet file prefix_length :: IO >> Data.ByteString.ByteString >> _ <- System.IO.hClose file >> let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx >> let hasher2 = Crypto.Hash.MD5.update hasher data_read :: >> Crypto.Hash.MD5.Ctx >> let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: >> Data.ByteString.ByteString >> let hex_digest = byte_string_to_hex binary_digest :: String >> return hex_digest :: IO String >> >> full_md5 :: String -> IO String >> full_md5 filename = do >> file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO >> System.IO.Handle >> data_read <- Data.ByteString.Lazy.hGetContents file :: IO >> Data.ByteString.Lazy.ByteString >> let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: >> Data.ByteString.ByteString >> let hex_digest = byte_string_to_hex binary_digest :: String >> -- Does this get closed for us later? >> -- strace shows the file getting closed without our explicit close. >> -- _ <- System.IO.hClose file >> return hex_digest :: IO String >> >> >> It might be easier to view these at >> http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/ >> , so the line numbers are precise. >> >> What is the deal? >> >> Can anyone tell me what should be running through my head to fix this >> kind of problem on my own in the future? >> >> Thanks! >> >> -- >> Dan Stromberg >> >> _______________________________________________ >> 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 > > -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Thu Dec 3 21:58:08 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Thu, 3 Dec 2015 13:58:08 -0800 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: I read somewhere (probably Learn You a Haskell or Real-World Haskell) that beginners should use a lot of type declarations, but perhaps that's not a great idea after all. Here's dph.hs without the type declarations and some abuses of do cleaned up: import Md5s import Split0 import System.IO get_filenames :: String -> [String] -- Let's hope this doesn't give locale-related roundtrip problems. get_filenames buffer = Split0.split0 '\0' buffer do_prefix_hash :: String -> (IO String, String) do_prefix_hash filename = let hash = Md5s.prefix_md5 filename in (hash, filename) tuple_to_string :: (String, String) -> String tuple_to_string (first, second) = (show first) ++ " " ++ (show second) main :: IO () main = do buffer <- (System.IO.hGetContents System.IO.stdin) let filenames = (get_filenames buffer) io_hash_tuples <- map do_prefix_hash filenames hash_tuples <- sequence io_hash_tuples let strings = map tuple_to_string hash_tuples mapM_ putStrLn strings The (far fewer) errors I get now are: dph.hs:21:23: Couldn't match type `[]' with `IO' Expected type: IO (IO String, String) Actual type: [(IO String, String)] In the return type of a call of `map' In a stmt of a 'do' block: io_hash_tuples <- map do_prefix_hash filenames In the expression: do { buffer <- (hGetContents stdin); let filenames = (get_filenames buffer); io_hash_tuples <- map do_prefix_hash filenames; hash_tuples <- sequence io_hash_tuples; .... } dph.hs:22:29: Couldn't match expected type `[IO (String, String)]' with actual type `(IO String, String)' In the first argument of `sequence', namely `io_hash_tuples' In a stmt of a 'do' block: hash_tuples <- sequence io_hash_tuples In the expression: do { buffer <- (hGetContents stdin); let filenames = (get_filenames buffer); io_hash_tuples <- map do_prefix_hash filenames; hash_tuples <- sequence io_hash_tuples; .... } I'm continuing to study Learn You a Haskell, though I'd kinda like to continue coding on this project in parallel. On Tue, Dec 1, 2015 at 7:47 PM, Simon Jakobi wrote: > Hi Dan, > > I'm having a hard time understanding those error messages too. It > seems to me that part of the problem is that GHC is confused by some > incorrect type annotations of yours. > > I suggest that you delete or at least comment out your own type > annotations and then either work with the hopefully simpler error-messages > from GHC or use the `:load` and `:type` commands in ghci to discover > the inferred > types for your functions. > > Depending on how close the inferred type is to the intended type, you > may have to adjust the definitions. > > Also note that you sometimes incorrectly and unnecessarily use > do-notation in "non-monadic"/plain functions, for example in > tuple_to_string and get_filenames. > > You could also consider following a book or a course until you feel > more comfortable trying things on your own: > Take a look at learnyouahaskell.com or github.com/bitemyapp/learnhaskell. > > Good luck! > Simon > > 2015-12-02 1:12 GMT+01:00, Dan Stromberg : > > I'm continuing my now-and-then exploration of Haskell. > > > > I'm getting a new crop of type errors that I'm pulling my hair out over. > > > > The errors I'm getting are: > > > > $ make > > below cmd output started 2015 Tue Dec 01 04:05:17 PM PST > > # --make will go out and find what to build > > ghc -Wall --make -o dph dph.hs Split0.hs > > [1 of 3] Compiling Split0 ( Split0.hs, Split0.o ) > > [2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o ) > > [3 of 3] Compiling Main ( dph.hs, dph.o ) > > > > dph.hs:13:13: > > Couldn't match type `IO' with `(,) (IO String)' > > Expected type: (IO String, String) > > Actual type: IO String > > In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String > > In the expression: > > do { hash <- prefix_md5 filename :: IO String; > > (hash, filename) } > > In an equation for `do_prefix_hash': > > do_prefix_hash filename > > = do { hash <- prefix_md5 filename :: IO String; > > (hash, filename) } > > > > dph.hs:14:6: > > Couldn't match type `[Char]' with `IO String' > > Expected type: IO String > > Actual type: String > > In the expression: hash > > In a stmt of a 'do' block: (hash, filename) > > In the expression: > > do { hash <- prefix_md5 filename :: IO String; > > (hash, filename) } > > > > dph.hs:24:23: > > Couldn't match type `[]' with `IO' > > Expected type: IO (IO String, String) > > Actual type: [(IO String, String)] > > In a stmt of a 'do' block: > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)] > > In the expression: > > do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > > .... } > > In an equation for `main': > > main > > = do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > .... } > > > > dph.hs:25:20: > > Couldn't match type `[a0]' with `(String, String)' > > Expected type: [(String, String)] > > Actual type: [[a0]] > > In the return type of a call of `sequence' > > In a stmt of a 'do' block: > > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > > In the expression: > > do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > > .... } > > > > dph.hs:25:20: > > Couldn't match type `[]' with `IO' > > Expected type: IO (String, String) > > Actual type: [(String, String)] > > In a stmt of a 'do' block: > > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > > In the expression: > > do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > > .... } > > In an equation for `main': > > main > > = do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > .... } > > > > dph.hs:25:29: > > Couldn't match expected type `[[a0]]' > > with actual type `(IO String, String)' > > In the first argument of `sequence', namely `io_hash_tuples' > > In a stmt of a 'do' block: > > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > > In the expression: > > do { buffer <- (hGetContents stdin) :: IO String; > > let filenames = ...; > > io_hash_tuples <- map do_prefix_hash filenames :: > > [(IO String, String)]; > > hash_tuples <- sequence io_hash_tuples :: [(String, String)]; > > .... } > > > > dph.hs:26:39: > > Couldn't match expected type `[(String, String)]' > > with actual type `(String, String)' > > In the second argument of `map', namely `hash_tuples' > > In the expression: map tuple_to_string hash_tuples :: [String] > > In an equation for `strings': > > strings = map tuple_to_string hash_tuples :: [String] > > make: *** [dph] Error 1 > > above cmd output done 2015 Tue Dec 01 04:05:18 PM PST > > > > > > dph.hs looks like: > > import Md5s > > import Split0 > > import System.IO > > > > get_filenames :: String -> [String] > > get_filenames buffer = do > > -- Let's hope this doesn't give locale-related roundtrip problems. > > Split0.split0 '\0' buffer :: [String] > > > > do_prefix_hash :: String -> (IO String, String) > > do_prefix_hash filename = do > > hash <- Md5s.prefix_md5 filename :: (IO String) > > (hash, filename) > > > > tuple_to_string :: (String, String) -> String > > tuple_to_string (first, second) = do > > (show first) ++ " " ++ (show second) > > > > main :: IO () > > main = do > > buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String > > let filenames = (get_filenames buffer) :: [String] > > io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, > String)] > > hash_tuples <- sequence io_hash_tuples :: [(String, String)] > > let strings = map tuple_to_string hash_tuples :: [String] > > mapM_ putStrLn strings > > > > > > And Md5s.hs looks like: > > module Md5s where > > > > import qualified System.IO > > import qualified Text.Printf > > -- cabal install cryptohash > > import qualified Crypto.Hash.MD5 > > import qualified Data.ByteString > > import qualified Data.ByteString.Lazy > > > > -- > > > http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation > > byte_string_to_hex :: Data.ByteString.ByteString -> String > > byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . > > Data.ByteString.unpack > > > > prefix_md5 :: String -> IO String > > prefix_md5 filename = do > > let prefix_length = 1024 > > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > > System.IO.Handle > > data_read <- Data.ByteString.hGet file prefix_length :: IO > > Data.ByteString.ByteString > > _ <- System.IO.hClose file > > let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx > > let hasher2 = Crypto.Hash.MD5.update hasher data_read :: > > Crypto.Hash.MD5.Ctx > > let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: > > Data.ByteString.ByteString > > let hex_digest = byte_string_to_hex binary_digest :: String > > return hex_digest :: IO String > > > > full_md5 :: String -> IO String > > full_md5 filename = do > > file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO > > System.IO.Handle > > data_read <- Data.ByteString.Lazy.hGetContents file :: IO > > Data.ByteString.Lazy.ByteString > > let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: > > Data.ByteString.ByteString > > let hex_digest = byte_string_to_hex binary_digest :: String > > -- Does this get closed for us later? > > -- strace shows the file getting closed without our explicit close. > > -- _ <- System.IO.hClose file > > return hex_digest :: IO String > > > > > > It might be easier to view these at > > > http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/ > > , so the line numbers are precise. > > > > What is the deal? > > > > Can anyone tell me what should be running through my head to fix this > kind > > of problem on my own in the future? > > > > Thanks! > > > > -- > > Dan Stromberg > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From jykang22 at gmail.com Fri Dec 4 04:46:25 2015 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Thu, 3 Dec 2015 23:46:25 -0500 Subject: [Haskell-beginners] Application of lookup function Message-ID: Hi all. I'd like to apply lookup function (Data.Map) for what I am working on. Here is my code. data Person = Person {personId :: Int, name = String} data People = [Person] data State = InMembership | NoMemebership person1 = Person {1 = personId, "James" = name} person2 = Person {2 = personId, "Tom" = name} members = People [person1, person2] class Belonging a where belonging :: a -> [a] -> Bool -> State here is the problem... I don't know how to get to know whether a person is belong to members. I'd like to find it through a person's name. Can you suggest any examples?? Sincerely, Jeon -------------- next part -------------- An HTML attachment was scrubbed... URL: From i.caught.air at gmail.com Fri Dec 4 04:50:51 2015 From: i.caught.air at gmail.com (Alex Belanger) Date: Thu, 3 Dec 2015 23:50:51 -0500 Subject: [Haskell-beginners] Application of lookup function In-Reply-To: References: Message-ID: The (`elem` members) function will tell you if the person is a member of members. You can then turn that boolean into your custom State type. On Dec 3, 2015 11:46 PM, "Jeon-Young Kang" wrote: > Hi all. > > I'd like to apply lookup function (Data.Map) for what I am working on. > > Here is my code. > > data Person = Person {personId :: Int, name = String} > data People = [Person] > > data State = InMembership | NoMemebership > > person1 = Person {1 = personId, "James" = name} > person2 = Person {2 = personId, "Tom" = name} > > members = People [person1, person2] > > class Belonging a where > belonging :: a -> [a] -> Bool -> State > > here is the problem... > I don't know how to get to know whether a person is belong to members. > I'd like to find it through a person's name. > > Can you suggest any examples?? > > Sincerely, > Jeon > > > > _______________________________________________ > 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 daniel.trstenjak at gmail.com Fri Dec 4 08:35:18 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Fri, 4 Dec 2015 09:35:18 +0100 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: <20151204083518.GA1841@octa> Hi Dan, > io_hash_tuples <- map do_prefix_hash filenames You're operating inside of the IO monad, so anything on the right hand side of the `<-` has to have the type `IO`. If you're looking up the type of `map`, you will see that it doesn't return the right type. Most likely you just wanted to create a binding like: let io_hash_tuples = map do_prefix_hash filenames > hash_tuples <- sequence io_hash_tuples `io_hash_tuples` is of type `[(IO String, String)]`, but `sequence` expects a `[IO a]`. Looking at your code, it's easier not to put the `IO String` computation of the hash into a tuple, but first compute all hashes: hashes <- sequence (map Md5s.prefix_md5 filenames) And if you want the hash and the filename grouped in a tuple: zip filenames hashes Greetings, Daniel From daniel.trstenjak at gmail.com Fri Dec 4 09:16:16 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Fri, 4 Dec 2015 10:16:16 +0100 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: <20151204083518.GA1841@octa> References: <20151204083518.GA1841@octa> Message-ID: <20151204091616.GA4649@octa> > hashes <- sequence (map Md5s.prefix_md5 filenames) That could be just written as: hashes <- mapM Md5s.prefix_md5 filenames Greetings, Daniel From jykang22 at gmail.com Fri Dec 4 22:16:55 2015 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Fri, 4 Dec 2015 17:16:55 -0500 Subject: [Haskell-beginners] Application of lookup function In-Reply-To: References: Message-ID: Thanks Alex. I successfully implemented what I want by using 'elem'. On Thu, Dec 3, 2015 at 11:50 PM, Alex Belanger wrote: > The (`elem` members) function will tell you if the person is a member of > members. You can then turn that boolean into your custom State type. > On Dec 3, 2015 11:46 PM, "Jeon-Young Kang" wrote: > >> Hi all. >> >> I'd like to apply lookup function (Data.Map) for what I am working on. >> >> Here is my code. >> >> data Person = Person {personId :: Int, name = String} >> data People = [Person] >> >> data State = InMembership | NoMemebership >> >> person1 = Person {1 = personId, "James" = name} >> person2 = Person {2 = personId, "Tom" = name} >> >> members = People [person1, person2] >> >> class Belonging a where >> belonging :: a -> [a] -> Bool -> State >> >> here is the problem... >> I don't know how to get to know whether a person is belong to members. >> I'd like to find it through a person's name. >> >> Can you suggest any examples?? >> >> Sincerely, >> Jeon >> >> >> >> _______________________________________________ >> 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 > > -- Department of Geography State University of New York at Buffalo jykang22 at gmail.com Jeon-Young Kang -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Sat Dec 5 00:50:22 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Fri, 4 Dec 2015 16:50:22 -0800 Subject: [Haskell-beginners] debugging help Message-ID: I'm getting an error, printf not having enough arguments. I need to find where this is happening, and I understand there are ways of getting a stack trace, but apparently I need to compile for profiling. That means I need to compile my one library dependency (Text.XML.Light) for profiling, I believe. How do I do this? I'm on Windows and have only installed libraries in the past with cabal. D -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Sat Dec 5 08:11:10 2015 From: magnus at therning.org (Magnus Therning) Date: Sat, 05 Dec 2015 09:11:10 +0100 Subject: [Haskell-beginners] debugging help In-Reply-To: References: Message-ID: <87bna58gdd.fsf@therning.org> Dennis Raddle writes: > I'm getting an error, printf not having enough arguments. I need to > find where this is happening, and I understand there are ways of > getting a stack trace, but apparently I need to compile for profiling. > That means I need to compile my one library dependency > (Text.XML.Light) for profiling, I believe. How do I do this? I'm on > Windows and have only installed libraries in the past with cabal. How many calls to `printf` do you actually have? Wouldn't a search for all calls and a quick inspection of them be good enough? /M -- Magnus Therning OpenPGP: 0xAB4DFBA4 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus If our ideas of intellectual property are wrong, we must change them, improve them and return them to their original purpose. When intellectual property rules diminish the supply of new ideas, they steal from all of us. -- Andrew Brown, November 19, 2005, The Guardian -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 162 bytes Desc: not available URL: From dennis.raddle at gmail.com Sat Dec 5 10:18:41 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Sat, 5 Dec 2015 02:18:41 -0800 Subject: [Haskell-beginners] debugging help In-Reply-To: <87bna58gdd.fsf@therning.org> References: <87bna58gdd.fsf@therning.org> Message-ID: I started by looking everywhere I thought I called printf in this particular case, and couldn't find a single problematic printf. Given the input I was using, I thought I knew where the printf was probably going to be. But that failed, and there are hundreds throughout the rest of the program. (I use them for generating output and warning/error messages--- I happen to like the format string method of describing your output.) Then I thought, I sure would like to learn more about the debugger and profiling, so I thought it was worth asking. I never have gotten clear on how to compile libraries for profiling. While waiting for a reply here, it struck me where the printf was, and I found it and solved the problem. So there's not an immediate need for the stack trace. D On Sat, Dec 5, 2015 at 12:11 AM, Magnus Therning wrote: > > Dennis Raddle writes: > > > I'm getting an error, printf not having enough arguments. I need to > > find where this is happening, and I understand there are ways of > > getting a stack trace, but apparently I need to compile for profiling. > > That means I need to compile my one library dependency > > (Text.XML.Light) for profiling, I believe. How do I do this? I'm on > > Windows and have only installed libraries in the past with cabal. > > How many calls to `printf` do you actually have? > > Wouldn't a search for all calls and a quick inspection of them be good > enough? > > /M > > -- > Magnus Therning OpenPGP: 0xAB4DFBA4 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > If our ideas of intellectual property are wrong, we must change them, > improve them and return them to their original purpose. When > intellectual property rules diminish the supply of new ideas, they > steal from all of us. > -- Andrew Brown, November 19, 2005, The Guardian > > _______________________________________________ > 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 k-bx at k-bx.com Sat Dec 5 15:48:27 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Sat, 5 Dec 2015 17:48:27 +0200 Subject: [Haskell-beginners] debugging help In-Reply-To: References: Message-ID: Not sure about windows, but for Linux ? you just do `stack build --executable-profiling` (for cabal it's `cabal --enable-executable-profiling`) to build with profiling. Also, I want to recommend a package called formatting http://hackage.haskell.org/package/formatting , which is a bit more type-safe way to format strings: format ("Person's name is " % text % ", age is " % hex) "Dave" 54 There are short-named formatters available, and if you omit spaces it would look almost as dense as printf. Cheers. On Sat, Dec 5, 2015 at 2:50 AM, Dennis Raddle wrote: > I'm getting an error, printf not having enough arguments. I need to find > where this is happening, and I understand there are ways of getting a stack > trace, but apparently I need to compile for profiling. That means I need to > compile my one library dependency (Text.XML.Light) for profiling, I > believe. How do I do this? I'm on Windows and have only installed libraries > in the past with cabal. > > D > > > _______________________________________________ > 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 tjakway at nyu.edu Sat Dec 5 17:11:57 2015 From: tjakway at nyu.edu (Thomas Jakway) Date: Sat, 5 Dec 2015 12:11:57 -0500 Subject: [Haskell-beginners] debugging help In-Reply-To: References: Message-ID: <56631ADD.2060205@nyu.edu> I wouldn't approach this from that perspective. If it's just a small codebase you might want to just grep -R "printf" . and look through each statement. To be honest I've never really used ghci for debugging (I'm definitely a beginner) but getting a stack trace seems like overkill and I'd be willing to bet ghci would be more productive anyway. If you really want to though the flag is -prof. To compile the library with it you could edit the .cabal file and add it under ghc-options. or cabal build --ghc-options="-prof" would probably also work. (if I'm wrong about any of the above I'd really appreciate it if someone more experienced than me would correct me so I don't make the same mistakes!) On 12/4/15 7:50 PM, Dennis Raddle wrote: > I'm getting an error, printf not having enough arguments. I need to > find where this is happening, and I understand there are ways of > getting a stack trace, but apparently I need to compile for profiling. > That means I need to compile my one library dependency > (Text.XML.Light) for profiling, I believe. How do I do this? I'm on > Windows and have only installed libraries in the past with cabal. > > D > > > > _______________________________________________ > 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 ovidiudeac at gmail.com Sat Dec 5 17:35:42 2015 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Sat, 5 Dec 2015 19:35:42 +0200 Subject: [Haskell-beginners] Issue with MultiParamTypeClasses Message-ID: I have the following code: {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} class Graph g a where vertices :: g a -> [a] edges :: g a-> [(a, a)] type AdjList a = [(a,[a])] instance Graph AdjList Int where vertices g = map fst g edges g = concatMap listEdges g where listEdges (startV, edges) = map (\endV -> (startV, endV)) edges but the compiler complains: """Type synonym ???AdjList??? should have 1 argument, but has been given none In the instance declaration for ???Graph AdjList Int??? """ How can I fix this error? Thanks! From hjgtuyl at chello.nl Sat Dec 5 23:31:07 2015 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 06 Dec 2015 00:31:07 +0100 Subject: [Haskell-beginners] debugging help In-Reply-To: References: Message-ID: On Sat, 05 Dec 2015 01:50:22 +0100, Dennis Raddle wrote: > I'm getting an error, printf not having enough arguments. I need to find > where this is happening, and I understand there are ways of getting a > stack > trace, but apparently I need to compile for profiling. That means I need > to > compile my one library dependency (Text.XML.Light) for profiling, I > believe. How do I do this? I'm on Windows and have only installed > libraries > in the past with cabal. Try the GHCi debugger: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci-debugger.html Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From rajasharan at gmail.com Sun Dec 6 00:20:58 2015 From: rajasharan at gmail.com (Raja) Date: Sat, 5 Dec 2015 19:20:58 -0500 Subject: [Haskell-beginners] foldr, Foldable and right-side folding Message-ID: foldr is supposed to start folding from the right side (as the name suggests). and this is why it is synonymous to "list construction" as I'm told for e.g: > foldr (:) [ ] [1,2,3,4,5] [1,2,3,4,5] In the same spirit I'm trying to construct a Foldable instance of my own type: data Li a = Nil | Cons a (Li a) deriving (Show) instance Foldable Li where foldr f b Nil = b foldr f b (Cons a y) = foldr f (f a b) y So I'm trying out foldr for my type: > foldr Cons Nil (Cons 1 (Cons 2 Nil)) Cons 2 (Cons 1 Nil) This shows my foldr implementation i'm not folding from right side, but how can I possibly do that - the data could have been an infinite stream. It feels like I will never be able to truly write a foldr implementation with "right" folding mechanism. Any thoughts? -------------- next part -------------- An HTML attachment was scrubbed... URL: From bergey at alum.mit.edu Sun Dec 6 03:24:03 2015 From: bergey at alum.mit.edu (Daniel Bergey) Date: Sat, 05 Dec 2015 22:24:03 -0500 Subject: [Haskell-beginners] foldr, Foldable and right-side folding In-Reply-To: References: Message-ID: <87d1uk9s4s.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> On 2015-12-05 at 19:20, Raja wrote: > foldr is supposed to start folding from the right side (as the name > suggests). > and this is why it is synonymous to "list construction" as I'm told > > for e.g: >> foldr (:) [ ] [1,2,3,4,5] > [1,2,3,4,5] > > In the same spirit I'm trying to construct a Foldable instance of my own > type: > > data Li a = Nil | Cons a (Li a) > deriving (Show) > > instance Foldable Li where > foldr f b Nil = b > foldr f b (Cons a y) = foldr f (f a b) y > > So I'm trying out foldr for my type: >> foldr Cons Nil (Cons 1 (Cons 2 Nil)) > Cons 2 (Cons 1 Nil) > > This shows my foldr implementation i'm not folding from right side, > but how can I possibly do that - the data could have been an infinite > stream. A right fold on an infinite stream can terminate if the function f sometimes discards it's second argument. For example, takeWhile can be implemented this way. You are right that `foldr Cons Nil` or `foldr (:) []` will not terminate on an infinite list. On the bright side, you 've written a perfectly good left fold, even though it doesn't have quite the signature Haskell gives foldl. bergey From davidblubaugh2000 at yahoo.com Sun Dec 6 15:21:15 2015 From: davidblubaugh2000 at yahoo.com (David Blubaugh) Date: Sun, 6 Dec 2015 15:21:15 +0000 (UTC) Subject: [Haskell-beginners] DOOM rewritten in the Haskell programming language. References: <451608938.16111539.1449415275423.JavaMail.yahoo.ref@mail.yahoo.com> Message-ID: <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> TO ALL, ?? Hello My name is David Allen Blubaugh. ?I am currently considering starting a kick-starter project in redeveloping the DOOM source code with the Haskell Programming language using the power of functional-oriented programming...... I know that John Carmack was interested in the Haskell programming language and had even recreated wolfenstein 3D using the Haskell programming language. ? Does anybody have a copy of John Carmack's recreation of wolfenstein 3D using haskell ??? ? Also would anybody enjoy working with this project ??? ?? What benefits would DOOM have enjoyed had ID software created the DOOM source code in 1993 with Haskell or some other functional-oriented programming language ?instead of C/assembly programming languages ??? ?? Thanks, David Allen BlubaughElectrical EngineerATR Associate ?? -------------- next part -------------- An HTML attachment was scrubbed... URL: From hjgtuyl at chello.nl Sun Dec 6 17:19:15 2015 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 06 Dec 2015 18:19:15 +0100 Subject: [Haskell-beginners] DOOM rewritten in the Haskell programming language. In-Reply-To: <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> References: <451608938.16111539.1449415275423.JavaMail.yahoo.ref@mail.yahoo.com> <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> Message-ID: On Sun, 06 Dec 2015 16:21:15 +0100, David Blubaugh wrote: > TO ALL, > Hello My name is David Allen Blubaugh. I am currently considering > starting a kick-starter project in redeveloping the DOOM source code > with the Haskell Programming language using the power of > functional-oriented programming...... > I know that John Carmack was interested in the Haskell programming > language and had even recreated wolfenstein 3D using the Haskell > programming language. Does anybody have a copy of John Carmack's > recreation of wolfenstein 3D using haskell ??? Also would anybody enjoy > working with this project ??? What benefits would DOOM have enjoyed had > ID software created the DOOM source code in 1993 with Haskell or some > other functional-oriented programming language instead of C/assembly > programming languages ??? Thanks, > David Allen BlubaughElectrical EngineerATR Associate I don't know about his source code, but the Games page[0] lists: - hadoom A clone of Doom, using reactive-banana, GTK, and the "diagrams" library. https://github.com/ocharles/hadoom - Frag A 3D first person shooting game https://wiki.haskell.org/Frag These might be helpful. Advantages, when developing software in Haskell, are faster development with fewer bugs. Disadvantages are: the compiled programs are slower then when written in C and the garbage collection of a Haskell program (when compiled with GHC) might sometimes cause delays in screen updates. Regards, Henk-Jan van Tuyl [0] https://wiki.haskell.org/Games -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From marcin.jan.mrotek at gmail.com Sun Dec 6 18:26:59 2015 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Sun, 6 Dec 2015 19:26:59 +0100 Subject: [Haskell-beginners] Issue with MultiParamTypeClasses In-Reply-To: References: Message-ID: Hello, This is not an issue with MultiParamTypeClasses. It's just that type synonyms always have to be used fully applied. You can use a newtype instead: newtype AdjList a = AdjList [(a,[a])] instance Graph AdjList Int where (...) Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From rajasharan at gmail.com Sun Dec 6 18:37:35 2015 From: rajasharan at gmail.com (Raja) Date: Sun, 6 Dec 2015 13:37:35 -0500 Subject: [Haskell-beginners] foldr, Foldable and right-side folding In-Reply-To: <87d1uk9s4s.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <87d1uk9s4s.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: On Sat, Dec 5, 2015 at 10:24 PM, Daniel Bergey wrote: > On 2015-12-05 at 19:20, Raja wrote: > > foldr is supposed to start folding from the right side (as the name > > suggests). > > and this is why it is synonymous to "list construction" as I'm told > > > > for e.g: > >> foldr (:) [ ] [1,2,3,4,5] > > [1,2,3,4,5] > > > > In the same spirit I'm trying to construct a Foldable instance of my own > > type: > > > > data Li a = Nil | Cons a (Li a) > > deriving (Show) > > > > instance Foldable Li where > > foldr f b Nil = b > > foldr f b (Cons a y) = foldr f (f a b) y > > > > So I'm trying out foldr for my type: > >> foldr Cons Nil (Cons 1 (Cons 2 Nil)) > > Cons 2 (Cons 1 Nil) > > > > This shows my foldr implementation i'm not folding from right side, > > but how can I possibly do that - the data could have been an infinite > > stream. > > A right fold on an infinite stream can terminate if the function f > sometimes discards it's second argument. For example, takeWhile can be > implemented this way. > > You are right that `foldr Cons Nil` or `foldr (:) []` will not terminate > on an infinite list. > > On the bright side, you 've written a perfectly good left fold, even > though it doesn't have quite the signature Haskell gives foldl. I see - I did write a foldl impl. instance Foldable Li where foldr f b Nil = b foldr f b (Cons a y) = f a (foldr f b y) Now the `b' is getting propagated all the way to right. Thanks. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tonymorris at gmail.com Mon Dec 7 01:11:28 2015 From: tonymorris at gmail.com (Tony Morris) Date: Mon, 7 Dec 2015 11:11:28 +1000 Subject: [Haskell-beginners] foldr, Foldable and right-side folding In-Reply-To: References: Message-ID: The foldr function does not start from the right. It associates to the right. This talk specifically addresses this common mistake. http://functionaltalks.org/2013/06/19/tony-morris-explain-list-folds-to-yourself/ On 06/12/2015 10:21 AM, "Raja" wrote: > foldr is supposed to start folding from the right side (as the name > suggests). > and this is why it is synonymous to "list construction" as I'm told > > for e.g: > > foldr (:) [ ] [1,2,3,4,5] > [1,2,3,4,5] > > In the same spirit I'm trying to construct a Foldable instance of my own > type: > > data Li a = Nil | Cons a (Li a) > deriving (Show) > > instance Foldable Li where > foldr f b Nil = b > foldr f b (Cons a y) = foldr f (f a b) y > > So I'm trying out foldr for my type: > > foldr Cons Nil (Cons 1 (Cons 2 Nil)) > Cons 2 (Cons 1 Nil) > > This shows my foldr implementation i'm not folding from right side, > but how can I possibly do that - the data could have been an infinite > stream. > It feels like I will never be able to truly write a foldr implementation > with "right" folding mechanism. > > Any thoughts? > > > _______________________________________________ > 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 alexander at plaimi.net Mon Dec 7 10:54:45 2015 From: alexander at plaimi.net (Alexander Berntsen) Date: Mon, 7 Dec 2015 11:54:45 +0100 Subject: [Haskell-beginners] DOOM rewritten in the Haskell programming language. In-Reply-To: <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> References: <451608938.16111539.1449415275423.JavaMail.yahoo.ref@mail.yahoo.com> <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> Message-ID: <56656575.8090109@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 David, I think it would be more valuable to make a DOOM-like game than to remake DOOM. Especially if you are going to aim for funding. The free software community has had this problem for years, where we point to remakes of old games as evidence to viability. It isn't. Nobody will be swayed by Haskell DOOM. (Although I would, personally, think it interesting.) Good luck with your project. - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWZWV0AAoJENQqWdRUGk8B0bMQAKu/4hBeS7Iz23IMIatrc5Jd hkWm/bG8FRCtiLyETiH9NtUL5RPtmS+s3+o05h6fZZ1VFFfzucygsmOTw27kWApc ZpZiypv22y7uJsrbyxFgXVp2w6vfp6rrdA+vRSOUp/dmJ+vnn7jVeGUInnlAKX50 WAsEUPx0q4IhGnF/2O3kBuKw/baGvp2kne2IjrgdAJ5qptVEvVoAEpIG3WveTnlP LQMBwTLrB+TkdTIZWTYUT/e8MYZorU5x6LN+GtKuO28PEEG0jS2IgfNeUnzZjalF p37Av84UCiIhTQD3LV6Eq1sQThQMVMm/S+qkqZrNL3I/+TbS3Ztf6q7u7zDRCsnr vum2JR0f9vtGfpd5j3hGVXjQTd0jU3uFdY1kHM0ISGTSKYrOGYs4qsCL/VxPubo8 Lh7YfCltXY+LQkz/Q2FElcd9eM9xYWSOBhPhiudXZ3f+PnkBNRwH03eWk/LHgmhB MByAdf2WCAU4DK7xpJKkCVsyOlsC17t8CtKDIfnt/RkPUr8108i6KOh6zvDR94Du lJyQWuCbL7FFb7uXVO7cKTeWJFejd/K5GrQBTBpVEy3xA15c8Kj+9ALWrdJAlion ktS85eEcp/3IzrNpPby8lhjJvujwzbzny+a9Jdn8ZcybBwpF3+IRSARnb7lJ4Yba Ca972BfXJnFZXiYARfov =mGnp -----END PGP SIGNATURE----- From sumit.sahrawat.apm13 at iitbhu.ac.in Mon Dec 7 11:04:56 2015 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Mon, 7 Dec 2015 16:34:56 +0530 Subject: [Haskell-beginners] DOOM rewritten in the Haskell programming language. In-Reply-To: <56656575.8090109@plaimi.net> References: <451608938.16111539.1449415275423.JavaMail.yahoo.ref@mail.yahoo.com> <451608938.16111539.1449415275423.JavaMail.yahoo@mail.yahoo.com> <56656575.8090109@plaimi.net> Message-ID: I'm interested in game development, and would be willing to learn and contribute if the project kicks off. Just showing my support, good luck with the project. On 7 December 2015 at 16:24, Alexander Berntsen wrote: > -----BEGIN PGP SIGNED MESSAGE----- > Hash: SHA512 > > David, > > I think it would be more valuable to make a DOOM-like game than to > remake DOOM. Especially if you are going to aim for funding. The free > software community has had this problem for years, where we point to > remakes of old games as evidence to viability. It isn't. Nobody will > be swayed by Haskell DOOM. (Although I would, personally, think it > interesting.) > > Good luck with your project. > - -- > Alexander > alexander at plaimi.net > https://secure.plaimi.net/~alexander > -----BEGIN PGP SIGNATURE----- > Version: GnuPG v2 > > iQIcBAEBCgAGBQJWZWV0AAoJENQqWdRUGk8B0bMQAKu/4hBeS7Iz23IMIatrc5Jd > hkWm/bG8FRCtiLyETiH9NtUL5RPtmS+s3+o05h6fZZ1VFFfzucygsmOTw27kWApc > ZpZiypv22y7uJsrbyxFgXVp2w6vfp6rrdA+vRSOUp/dmJ+vnn7jVeGUInnlAKX50 > WAsEUPx0q4IhGnF/2O3kBuKw/baGvp2kne2IjrgdAJ5qptVEvVoAEpIG3WveTnlP > LQMBwTLrB+TkdTIZWTYUT/e8MYZorU5x6LN+GtKuO28PEEG0jS2IgfNeUnzZjalF > p37Av84UCiIhTQD3LV6Eq1sQThQMVMm/S+qkqZrNL3I/+TbS3Ztf6q7u7zDRCsnr > vum2JR0f9vtGfpd5j3hGVXjQTd0jU3uFdY1kHM0ISGTSKYrOGYs4qsCL/VxPubo8 > Lh7YfCltXY+LQkz/Q2FElcd9eM9xYWSOBhPhiudXZ3f+PnkBNRwH03eWk/LHgmhB > MByAdf2WCAU4DK7xpJKkCVsyOlsC17t8CtKDIfnt/RkPUr8108i6KOh6zvDR94Du > lJyQWuCbL7FFb7uXVO7cKTeWJFejd/K5GrQBTBpVEy3xA15c8Kj+9ALWrdJAlion > ktS85eEcp/3IzrNpPby8lhjJvujwzbzny+a9Jdn8ZcybBwpF3+IRSARnb7lJ4Yba > Ca972BfXJnFZXiYARfov > =mGnp > -----END PGP SIGNATURE----- > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Regards Sumit Sahrawat -------------- next part -------------- An HTML attachment was scrubbed... URL: From tkoster at gmail.com Tue Dec 8 03:53:51 2015 From: tkoster at gmail.com (Thomas Koster) Date: Tue, 8 Dec 2015 14:53:51 +1100 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: Message-ID: On 4 December 2015 at 08:58, Dan Stromberg wrote: > I read somewhere (probably Learn You a Haskell or Real-World Haskell) that > beginners should use a lot of type declarations, but perhaps that's not a > great idea after all. I agree. Excessive type signatures makes code harder to read, less "beautiful" (yes, Haskell code can be beautiful), and increases the surface area for bugs, typos and other mistakes. Type inference in Haskell is an excellent aid for beginners and pros alike, and beginners should learn to feel comfortable with it. Haskell style commentators generally agree that type signatures for top-level bindings are a good thing, but they should be used sparingly everywhere else. If you are using GHC, I have also found that temporarily removing some top-level type signatures and compiling with -Wall may give you some new insights into your functions. GHC warns you about the missing signatures and tells you what it infers, which may be more general/polymorphic than the type you originally entered. This can help greatly to spot polymorphic functions, reduce code duplication and find places where you can use folds and traversals from the standard library (Data.Foldable, Data.Traversable, etc.). -- Thomas Koster From ovidiudeac at gmail.com Tue Dec 8 07:20:19 2015 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Tue, 8 Dec 2015 09:20:19 +0200 Subject: [Haskell-beginners] Issue with MultiParamTypeClasses In-Reply-To: References: Message-ID: Indeed, with newtype it works like a charm. Thanks! On Sun, Dec 6, 2015 at 8:26 PM, Marcin Mrotek wrote: > Hello, > > This is not an issue with MultiParamTypeClasses. It's just that type > synonyms always have to be used fully applied. You can use a newtype > instead: > > newtype AdjList a = AdjList [(a,[a])] > > instance Graph AdjList Int where > (...) > > Best regards, > Marcin Mrotek > > > _______________________________________________ > 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 kaddkaka at gmail.com Tue Dec 8 11:45:03 2015 From: kaddkaka at gmail.com (David Moberg) Date: Tue, 8 Dec 2015 12:45:03 +0100 Subject: [Haskell-beginners] Functional Programming for the Object Oriented In-Reply-To: References: Message-ID: Thanks I liked this video! :) 2015-11-18 20:35 GMT+01:00 ?ystein Kolsrud : > I gave a presentation on functional programming a couple of weeks ago > that I thought might be of interest to this community as well: > > https://www.youtube.com/watch?v=I2tMmsZC1ZU > > It's target audience is programmers familiar with object oriented > programming, and it presents how concepts from the functional paradigm > are relevant also in most modern OO languages. > > For more information about the presentation, please refer to the following > site: > > > http://www.foocafe.org/previous_event/functional-programming-for-the-object-oriented > > -- > Mvh ?ystein Kolsrud > _______________________________________________ > 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 qhfgva at gmail.com Tue Dec 8 14:55:51 2015 From: qhfgva at gmail.com (Dustin Lee) Date: Tue, 8 Dec 2015 07:55:51 -0700 Subject: [Haskell-beginners] Getting Crypto package imported Message-ID: I used cabal to install Crypto and it seemed to work fine Here is what I see at the prompt when I try to import the module $ ghci GHCi, version 7.4.1: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :m +Crypto : Could not find module `Crypto' It is not a module in the current program, or in any known package. Prelude> :m +Crypto.Hash : Could not find module `Crypto.Hash' It is not a module in the current program, or in any known package. Prelude> :m +Crypto.Hash.Data : Could not find module `Crypto.Data' It is not a module in the current program, or in any known package. Here is my package list. $ ghc-pkg list /var/lib/ghc/package.conf.d Cabal-1.14.0 array-0.4.0.0 base-4.5.0.0 bin-package-db-0.0.0.0 binary-0.5.1.0 bytestring-0.9.2.1 containers-0.4.2.1 deepseq-1.3.0.0 directory-1.1.0.2 extensible-exceptions-0.1.1.4 filepath-1.3.0.0 ghc-7.4.1 ghc-prim-0.2.0.0 haskell2010-1.1.0.1 haskell98-2.0.0.1 hoopl-3.8.7.3 hpc-0.5.1.1 integer-gmp-0.4.0.0 old-locale-1.0.0.4 old-time-1.1.0.0 pretty-1.1.1.0 process-1.1.0.1 rts-1.0 template-haskell-2.7.0.0 time-1.4 unix-2.5.1.0 /home/dlee/.ghc/i386-linux-7.4.1/package.conf.d Crypto-4.2.5.1 HUnit-1.3.0.0 QuickCheck-2.8.1 primitive-0.6.1.0 random-1.1 tf-random-0.5 transformers-0.4.3.0 I'd appreciate tips on how to troubleshoot what's going on. -- Dustin Lee qhfgva=rot13(dustin) ?( ? )? -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Tue Dec 8 15:10:30 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 8 Dec 2015 22:10:30 +0700 Subject: [Haskell-beginners] Getting Crypto package imported In-Reply-To: References: Message-ID: On Tue, Dec 8, 2015 at 9:55 PM, Dustin Lee wrote: > Prelude> :m +Crypto A glance at the main listing here: https://hackage.haskell.org/package/Crypto reveals that the module names are like Data.Digest.MD5 Codec.Encryption.AES So ":m +Data.Digest.MD5" should work. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From qhfgva at gmail.com Tue Dec 8 15:33:58 2015 From: qhfgva at gmail.com (Dustin Lee) Date: Tue, 8 Dec 2015 08:33:58 -0700 Subject: [Haskell-beginners] Getting Crypto package imported In-Reply-To: References: Message-ID: Ugg... Thanks. I was following a tutorial that used different import names. I guess either the names changed since then or I grabbed a different package. In any case, thanks! On Tue, Dec 8, 2015 at 8:10 AM, Kim-Ee Yeoh wrote: > > On Tue, Dec 8, 2015 at 9:55 PM, Dustin Lee wrote: > >> Prelude> :m +Crypto > > > A glance at the main listing here: > > https://hackage.haskell.org/package/Crypto > > reveals that the module names are like > > Data.Digest.MD5 > Codec.Encryption.AES > > So ":m +Data.Digest.MD5" should work. > > -- Kim-Ee > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Dustin Lee qhfgva=rot13(dustin) ?( ? )? -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Tue Dec 8 15:42:46 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 8 Dec 2015 22:42:46 +0700 Subject: [Haskell-beginners] Getting Crypto package imported In-Reply-To: References: Message-ID: On Tue, Dec 8, 2015 at 10:33 PM, Dustin Lee wrote: > I was following a tutorial that used different import names. I guess > either the names changed since then or I grabbed a different package. Is the tutorial on the web? Perhaps you could contact the author to update it or add clarifying information? -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From mvillagra0 at gmail.com Tue Dec 8 15:44:18 2015 From: mvillagra0 at gmail.com (=?UTF-8?Q?Mart=C3=ADn_Villagra?=) Date: Tue, 8 Dec 2015 12:44:18 -0300 Subject: [Haskell-beginners] problem with SDL-gfx Message-ID: Hello! I hope you can help me. I'm trying to use SDL-gfx but it seems it isn't linking it correctly. When I try to run this simple file with runhaskell: import Graphics.UI.SDL.Primitives main = putStrLn "Hello" It gives: sdl.test.hs: : can't load .so/.DLL for: /home/username/.cabal/lib/i386-linux-ghc-7.10.2/SDL-gfx-0.6.0.1-6rhSP5mw8M00K9S8yASTVF/ libHSSDL-gfx-0.6.0.1-6rhSP5mw8M00K9S8yASTVF-ghc7.10.2.so (/home/username/.cabal/lib/i386-linux-ghc-7.10.2/SDL-gfx-0.6.0.1-6rhSP5mw8M00K9S8yASTVF/ libHSSDL-gfx-0.6.0.1-6rhSP5mw8M00K9S8yASTVF-ghc7.10.2.so: undefined symbol: SDL_initFramerate) Notes: * SDL works fine in all cases. * My system is i386, using Arch Linux. I tried with another computer with x86_64 with Arch Linux and it worked. * It works if I compile it with ghc and run the executable. * I installed the package using cabal install SDL-gfx with no errors. * I installed the library in the OS just in case, and double checked that it exist in /usr/lib/libSDL_gfx.so and that it contains the symbol SDL_initFramerate. * The long *.so library reported by runhaskell also constains SDL_initFramerate. * GHCi gives the same error (when executing main). * I'm trying to make a cabal package that uses this library, and cabal gave the same error within the sandbox. -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Tue Dec 8 18:58:46 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 8 Dec 2015 19:58:46 +0100 Subject: [Haskell-beginners] problem with SDL-gfx In-Reply-To: References: Message-ID: <20151208185846.GA13232@casa.casa> On Tue, Dec 08, 2015 at 12:44:18PM -0300, Mart?n Villagra wrote: > Hello! > I hope you can help me. I'm trying to use SDL-gfx but it seems it isn't > linking it correctly. When I try to run this simple file with runhaskell: > import Graphics.UI.SDL.Primitives > main = putStrLn "Hello" > > It gives: > sdl.test.hs: : can't load .so/.DLL for: > [..] Hello Mart?n, SDL-gfx maintainer here. Could you try: runhaskell -L/usr/include/SDL/ -lSDL_gfx prova.hs (this works in Debian, modify the -L dir appropriately if you are using Arch). From dennis.raddle at gmail.com Tue Dec 8 21:19:27 2015 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Tue, 8 Dec 2015 13:19:27 -0800 Subject: [Haskell-beginners] how to write this function Message-ID: In my music translation program, I have a ton of data and configuration that goes into every note computation, so I've decided to use the State monad to pass it around. Also, the generated output is just a list of MIDI events, so I think I'll use Writer to gather the output. I will be dealing with several different MIDI synthesizers, which have different specifications and manner of control. But there is enough in common that I can write a single function to do the translation, provided that I provide that function with some data that is specific to the synth, and also I need to configure it with some functions specific to the synth. Let's say my State/Writer type is called Tr. type Tr a = StateT Configuration (Writer [MidiEvent]) a This is the data I provide to StateT: data Configuration = Configuration { t1 :: SynthSpecificData , f1 :: Tr SynthSpecificComputationResult , score :: WholeMusicalScore } So I need to write translate :: Tr () computeMidiEvents = runWriter (runStateT translate theConfig) So inside 'translate' I want to call 'f1' among many other things. Let's just consider the f1 call first. I wrote this first: translate = do f <- gets f1 f That works but looks a little weird. I think this works also: translate = join (gets f1) Is that better? D -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Tue Dec 8 22:29:22 2015 From: martin.drautzburg at web.de (martin) Date: Tue, 8 Dec 2015 23:29:22 +0100 Subject: [Haskell-beginners] Replacing equals with equals not working Message-ID: <566759C2.7030804@web.de> Hello all, with this code import Data.List import Data.Function data Tree a = B a (Tree a) (Tree a) | L a Char deriving Show get (B a _ _) = a get (L a _) = a tcmp = compare `on` get build :: [Tree Int] -> [Tree Int] build (t:[]) = [t] -- build t = let xs = sortBy (compare `on` get) t -- < -- build t = let xs = sortBy tcmp t in build (merge (xs!!0) (xs!!1) : drop 2 xs) The commented line -- < -- does not work, though I am just replacing equals with equals. I get No instance for (Ord b0) arising from a use of ?compare? The type variable ?b0? is ambiguous Relevant bindings include tcmp :: Tree b0 -> Tree b0 -> Ordering (bound at /home/martin/projects/haskell/exercises/99_questions/xxx.hs:10:1) Note: there are several potential instances: instance Integral a => Ord (GHC.Real.Ratio a) -- Defined in ?GHC.Real? instance Ord a => Ord (Control.Applicative.ZipList a) -- Defined in ?Control.Applicative? instance Ord Integer -- Defined in ?integer-gmp:GHC.Integer.Type? ...plus 24 others In the first argument of ?on?, namely ?compare? In the expression: compare `on` get In an equation for ?tcmp?: tcmp = compare `on` get Why is that so? From fa-ml at ariis.it Wed Dec 9 00:03:32 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Wed, 9 Dec 2015 01:03:32 +0100 Subject: [Haskell-beginners] Replacing equals with equals not working In-Reply-To: <566759C2.7030804@web.de> References: <566759C2.7030804@web.de> Message-ID: <20151209000332.GA2448@casa.casa> On Tue, Dec 08, 2015 at 11:29:22PM +0100, martin wrote: > Hello all, > > with this code > > [...] > > The commented line -- < -- does not work, though I am just replacing equals > with equals. I get > > No instance for (Ord b0) arising from a use of ?compare? Try to erase the `build` function and see what happens; You will get the same error. GHC complains that there is no good `Ord` instance and this can be solved by adding an appropriate type signature: tcmp :: (Ord a) => Tree a -> Tree a -> Ordering Now, with the `build` function present (the one with `let xs = sortBy tcmp t`), GHC will infer `tcmp` signature, as t is an Int ?> :t tcmp tcmp :: Tree Int -> Tree Int -> Ordering as since Int is an instance of Ord everything is fine. Does that help? From hjgtuyl at chello.nl Wed Dec 9 00:13:32 2015 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Wed, 09 Dec 2015 01:13:32 +0100 Subject: [Haskell-beginners] Replacing equals with equals not working In-Reply-To: <566759C2.7030804@web.de> References: <566759C2.7030804@web.de> Message-ID: On Tue, 08 Dec 2015 23:29:22 +0100, martin wrote: : > data Tree a = B a (Tree a) (Tree a) | L a Char deriving Show > > get (B a _ _) = a > get (L a _) = a > > tcmp = compare `on` get > > build :: [Tree Int] -> [Tree Int] > build (t:[]) = [t] > -- build t = let xs = sortBy (compare `on` get) t -- < -- > build t = let xs = sortBy tcmp t > in build (merge (xs!!0) (xs!!1) : drop 2 xs) > > > The commented line -- < -- does not work, though I am just replacing > equals with equals. I get > > No instance for (Ord b0) arising from a use of ?compare? > The type variable ?b0? is ambiguous > Relevant bindings include > tcmp :: Tree b0 -> Tree b0 -> Ordering : > Why is that so? If you do not use the function tcmp, the compiler can not deduce the type of it. When you add a type like tcmp :: Ord a => Tree a -> Tree a -> Ordering , the compiler has enough information to compile the program. Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From mvillagra0 at gmail.com Wed Dec 9 00:21:39 2015 From: mvillagra0 at gmail.com (=?UTF-8?Q?Mart=C3=ADn_Villagra?=) Date: Tue, 8 Dec 2015 21:21:39 -0300 Subject: [Haskell-beginners] problem with SDL-gfx In-Reply-To: <20151208185846.GA13232@casa.casa> References: <20151208185846.GA13232@casa.casa> Message-ID: Same error :/ The include folder (/usr/include/SDL/) contained the expected files. (SDL_framerate.h and others) I even recompiled and reinstalled the library but still says the same. On Tue, Dec 8, 2015 at 3:58 PM, Francesco Ariis wrote: > On Tue, Dec 08, 2015 at 12:44:18PM -0300, Mart?n Villagra wrote: > > Hello! > > I hope you can help me. I'm trying to use SDL-gfx but it seems it isn't > > linking it correctly. When I try to run this simple file with runhaskell: > > import Graphics.UI.SDL.Primitives > > main = putStrLn "Hello" > > > > It gives: > > sdl.test.hs: : can't load .so/.DLL for: > > [..] > > Hello Mart?n, SDL-gfx maintainer here. Could you try: > > runhaskell -L/usr/include/SDL/ -lSDL_gfx prova.hs > > (this works in Debian, modify the -L dir appropriately if you are using > Arch). > _______________________________________________ > 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 martin.drautzburg at web.de Wed Dec 9 09:13:58 2015 From: martin.drautzburg at web.de (martin) Date: Wed, 9 Dec 2015 10:13:58 +0100 Subject: [Haskell-beginners] Replacing equals with equals not working In-Reply-To: <20151209000332.GA2448@casa.casa> References: <566759C2.7030804@web.de> <20151209000332.GA2448@casa.casa> Message-ID: <5667F0D6.5010005@web.de> Am 12/09/2015 um 01:03 AM schrieb Francesco Ariis: > On Tue, Dec 08, 2015 at 11:29:22PM +0100, martin wrote: >> Hello all, >> >> with this code >> >> [...] >> >> The commented line -- < -- does not work, though I am just replacing equals >> with equals. I get >> >> No instance for (Ord b0) arising from a use of ?compare? > > Try to erase the `build` function and see what happens; You will get > the same error. GHC complains that there is no good `Ord` instance > and this can be solved by adding an appropriate type signature: > > tcmp :: (Ord a) => Tree a -> Tree a -> Ordering > > Now, with the `build` function present (the one with > `let xs = sortBy tcmp t`), GHC will infer `tcmp` signature, as t is > an Int > > ?> :t tcmp > tcmp :: Tree Int -> Tree Int -> Ordering > > as since Int is an instance of Ord everything is fine. > Does that help? Oh, I see. I was assuming the message referred to the build function (because I made chages there) and not to tcmp. Didn't check the line number. But really tcmp has lost its roots by not being used in build anymore. From abhisandhyasp.ap at gmail.com Wed Dec 9 17:53:28 2015 From: abhisandhyasp.ap at gmail.com (Abhijit Patel) Date: Wed, 9 Dec 2015 23:23:28 +0530 Subject: [Haskell-beginners] how to get started? Message-ID: i want to start contributing for the haskell community how and from where should i start? -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Wed Dec 9 21:19:28 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Wed, 9 Dec 2015 13:19:28 -0800 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: <20151204083518.GA1841@octa> References: <20151204083518.GA1841@octa> Message-ID: Hi. On Fri, Dec 4, 2015 at 12:35 AM, Daniel Trstenjak < daniel.trstenjak at gmail.com> wrote: > > > Looking at your code, it's easier not to put the `IO String` computation > of the hash into a tuple, but first compute all hashes: > > hashes <- sequence (map Md5s.prefix_md5 filenames) > > > And if you want the hash and the filename grouped in a tuple: > > zip filenames hashes What if I want to be able to deal gracefully with files that aren't readable, whether due to permissions issues or I/O errors? I agree that zip'ing is easier, but is it as robust? Thanks. -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Wed Dec 9 21:51:48 2015 From: magnus at therning.org (Magnus Therning) Date: Wed, 09 Dec 2015 22:51:48 +0100 Subject: [Haskell-beginners] how to get started? In-Reply-To: References: Message-ID: <87fuzbuw7f.fsf@therning.org> Abhijit Patel writes: > i want to start contributing for the haskell community how and from where > should i start? While learning you can improve the Wiki articles and any other resources you use. Also, if you are the kind of person who experiments with libs to work out how to use them, then you can submit those experiments as examples to be included in the libs' documentation. /M -- Magnus Therning OpenPGP: 0xAB4DFBA4 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus If our ideas of intellectual property are wrong, we must change them, improve them and return them to their original purpose. When intellectual property rules diminish the supply of new ideas, they steal from all of us. -- Andrew Brown, November 19, 2005, The Guardian -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 162 bytes Desc: not available URL: From mvillagra0 at gmail.com Thu Dec 10 00:38:36 2015 From: mvillagra0 at gmail.com (=?UTF-8?Q?Mart=C3=ADn_Villagra?=) Date: Wed, 9 Dec 2015 21:38:36 -0300 Subject: [Haskell-beginners] Netwire and event accumulator Message-ID: Hi. I'm trying to do a simulation using Netwire 5 and SDL but as I've just started with Netwire I'm not sure if I'm doing it correctly regarding the input events. Suppose I have a game which consists in moving a single pixel around the screen. To make this game, I created these simple wires: readEvent :: Wire s e IO a SDL.Event (SDL.Event can be SDL.NoEvent or an event just like Netwire's events, so I guess they can be easily converted) inputLogic :: Wire s m SDL.Event Position (it keeps the position as an internal state and updates it according to the event) render :: Wire s e IO Position ( ) (just writes the pixel to the screen) And finally the game can be expressed using Arrow notation as: readEvent>>>inputLogic>>>render It works. But the thing here is that events like mouse movement are generated way faster than frames. To solve this, inputLogic should read all the input events until there are none and only then render the frame. I'm unable to do this using Wires. I've tried to make some kind of loop with ArrowLoop but I failed. I did came up with this solution, creating different wires: readEvents :: Wire s e IO a [SDL.Event] (it populates the list until there are no more events) inputLogic' :: Wire s m [SDL.Event] Position And the game is: readEvents>>>inputLogic'>>>render Which does the expected behaviour but it doesn't seem a good approach to me. These new wires aren't as basic as the first ones. Is this the best way to do it? Does anybody has a better idea? Any advice will be considerably appreciated. Mart?n -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Thu Dec 10 00:57:49 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Thu, 10 Dec 2015 07:57:49 +0700 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: <20151204083518.GA1841@octa> Message-ID: On Thu, Dec 10, 2015 at 4:19 AM, Dan Stromberg wrote: What if I want to be able to deal gracefully with files that aren't > readable, whether due to permissions issues or I/O errors? I agree that > zip'ing is easier, but is it as robust? Making sense of this question requires an apples-to-apples comparison. Observe that the original code doesn't deal with read errors either. In fact, the replies in this thread have done only two things. They've fixed the typecheck error. And they've offered idiomatic -- but semantically identical -- rewritings that read-fault in the exact same way as the original code. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Thu Dec 10 01:35:07 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Wed, 9 Dec 2015 17:35:07 -0800 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: <20151204083518.GA1841@octa> Message-ID: On Wed, Dec 9, 2015 at 4:57 PM, Kim-Ee Yeoh wrote: > > > On Thu, Dec 10, 2015 at 4:19 AM, Dan Stromberg wrote: > > What if I want to be able to deal gracefully with files that aren't >> readable, whether due to permissions issues or I/O errors? I agree that >> zip'ing is easier, but is it as robust? > > > Making sense of this question requires an apples-to-apples comparison. > Observe that the original code doesn't deal with read errors either. > > In fact, the replies in this thread have done only two things. > > They've fixed the typecheck error. > > And they've offered idiomatic -- but semantically identical -- rewritings > that read-fault in the exact same way as the original code. > Yes, sure. My thought was that going over the list of filenames+sizes and adding prefix hashes where available, would be easier to make robust, than attempting to get prefix hashes for all and zipping the results. Is that not correct? Should I use a Maybe to deal with files that don't hash, so there will always be a one-to-one correspondence, allowing a zip? Thanks. -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Thu Dec 10 02:39:30 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Thu, 10 Dec 2015 09:39:30 +0700 Subject: [Haskell-beginners] More type errors I'm having trouble with In-Reply-To: References: <20151204083518.GA1841@octa> Message-ID: On Thu, Dec 10, 2015 at 8:35 AM, Dan Stromberg wrote: My thought was that going over the list of filenames+sizes and adding > prefix hashes where available, would be easier to make robust, than > attempting to get prefix hashes for all and zipping the results. > > Is that not correct? > No, that's not correct. And the reason is that zipping is a pure computation (to use the jargon). The errors can only come from file I/O. Tupling incrementally and tupling all at once (namely, zipping) result in identical values. Neither can fault unless the code goes out of its way into un-idiomatic, un-Haskelly territory. > Should I use a Maybe to deal with files that don't hash, so there will > always be a one-to-one correspondence, allowing a zip? > Yes, to be precise, instead of a function :: FilePath -> IO String that could possibly throw IO exceptions, you'd write a FilePath -> IO (Maybe String) that's exception-free because it catches them. Thanks. > Anytime. > > -- > Dan Stromberg > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Thu Dec 10 04:34:08 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Thu, 10 Dec 2015 05:34:08 +0100 Subject: [Haskell-beginners] problem with SDL-gfx In-Reply-To: References: <20151208185846.GA13232@casa.casa> Message-ID: <20151210043408.GA23230@casa.casa> On Tue, Dec 08, 2015 at 09:21:39PM -0300, Mart?n Villagra wrote: > Same error :/ > The include folder (/usr/include/SDL/) contained the expected files. > (SDL_framerate.h and others) > I even recompiled and reinstalled the library but still says the same. Gotcha, I forgot to to put an extra-libraries: in the .cabal file (let me thank Ivan Perez, who had a similar problem on sdl-image and provided the right diagnosis). I have uploaded the new version to hackage, install it and then type: runhaskell -lSDL_gfx your-test-file.hs It should work. Ciao -F From simon at mintsource.org Thu Dec 10 12:43:45 2015 From: simon at mintsource.org (Simon Peter Nicholls) Date: Thu, 10 Dec 2015 13:43:45 +0100 Subject: [Haskell-beginners] How can I lift my function taking a function to a Monad? Message-ID: <1449751425.3167.0@smtp.gmail.com> Hi All, Can anyone help me lift a function that takes a function, so it can be used in a Monad? The function I am given looks like "((b -> b) -> a -> a)", and viewing the definition of liftM2, it's almost what I need: liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 f m1 m2 = do x1 <- m1 x2 <- m2 return (f x1 x2) but I get the error: Expected type: (m b -> m b) -> m a -> m a Actual type: m (b -> b) -> m a -> m a which makes sense, as liftM2 just wraps my function arg, whereas the function itself needs to operate on monadic values. So I figure I need: neededLift :: (Monad m) => ((b -> b) -> a -> a) -> (m b -> m b) -> m a -> m a Despite a rough appreciation of how liftM2 works ("unpack" desired monadic versions of the args, apply the function, then return to put result back in the Monad), my mind keeps hazing over regarding the changes I need to make in this case. I've tried implementing neededLift by composing other functions, and also by manual Monad wrangling, but the intuitive leap remains elusive. I posted the specific problem over at SO (http://stackoverflow.com/questions/34152747/how-can-i-lift-an-fclabels-lens-to-a-monad), but I think the specifics may be clouding what is probably a straightforward problem. Cheers, Si -------------- next part -------------- An HTML attachment was scrubbed... URL: From mvillagra0 at gmail.com Thu Dec 10 14:10:55 2015 From: mvillagra0 at gmail.com (=?UTF-8?Q?Mart=C3=ADn_Villagra?=) Date: Thu, 10 Dec 2015 11:10:55 -0300 Subject: [Haskell-beginners] problem with SDL-gfx In-Reply-To: <20151210043408.GA23230@casa.casa> References: <20151208185846.GA13232@casa.casa> <20151210043408.GA23230@casa.casa> Message-ID: It works perfect now :D :D Now I can use it in my project, I didn't even need the -lSDL_gfx. Many thanks for this fast fix! On Thu, Dec 10, 2015 at 1:34 AM, Francesco Ariis wrote: > On Tue, Dec 08, 2015 at 09:21:39PM -0300, Mart?n Villagra wrote: > > Same error :/ > > The include folder (/usr/include/SDL/) contained the expected files. > > (SDL_framerate.h and others) > > I even recompiled and reinstalled the library but still says the same. > > Gotcha, I forgot to to put an extra-libraries: in the .cabal file > (let me thank Ivan Perez, who had a similar problem on sdl-image and > provided the right diagnosis). > > I have uploaded the new version to hackage, install it and then type: > > runhaskell -lSDL_gfx your-test-file.hs > > It should work. Ciao > -F > -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon at mintsource.org Thu Dec 10 15:16:40 2015 From: simon at mintsource.org (Simon Peter Nicholls) Date: Thu, 10 Dec 2015 16:16:40 +0100 Subject: [Haskell-beginners] How can I lift my function taking a function to a Monad? In-Reply-To: <877fkm9zam.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <1449751425.3167.0@smtp.gmail.com> <877fkm9zam.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: <1449760600.3167.1@smtp.gmail.com> Hiya, That would certainly explain why I found it difficult. Here's the original definition: liftMLabel :: Monad m => a :-> b -> m a :-> m b liftMLabel l = label (liftM $ get l) (liftM2 $ set l) Are here's a sample iteration of me hacking around: liftMLens :: Monad m => a :-> b -> m a :-> m b liftMLens l = lens getter modifier where getter = liftM $ get l modifier mf mm = mf >>= \ f -> modify l f `liftM` mm I only ever seem to replicate liftM2 characteristics when trying to brute force an implementation. And the implementations get more and more brutish as time goes on! It makes me wonder if the implications of fclabels `m a :-> m b` are radically different now, bearing in mind the original code worked. The fclabels :-> type operator has convinced the compiler that `m b -> mb` is required for the actual value modifying function. Does `m a :-> m b` make sense for the latest releases of fclabels? Is it just the lifting that's a problem? Si On Thu, 10 Dec, 2015 at 3:02 PM, Daniel Bergey wrote: > On 2015-12-10 at 07:43, Simon Peter Nicholls > wrote: >> So I figure I need: >> >> neededLift :: (Monad m) => ((b -> b) -> a -> a) -> (m b -> m b) -> >> m a >> -> m a > > I don't believe `neededLift` is possible. The type says that given > any > function `m b -> m b`, you can turn that function into one of type `b > -> > b` (as input to the lens). -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Thu Dec 10 17:43:02 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Fri, 11 Dec 2015 00:43:02 +0700 Subject: [Haskell-beginners] How can I lift my function taking a function to a Monad? In-Reply-To: <1449760600.3167.1@smtp.gmail.com> References: <1449751425.3167.0@smtp.gmail.com> <877fkm9zam.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <1449760600.3167.1@smtp.gmail.com> Message-ID: On Thu, Dec 10, 2015 at 10:16 PM, Simon Peter Nicholls wrote: > Does `m a :-> m b` make sense for the latest releases of fclabels? Is it > just the lifting that's a problem? Yes, you can still write a function of type Monad m => (a :-> b) -> (m a :-> m b). But it's gotten a bit trickier as you can tell. The wrong way is to try to write: neededLift :: (Monad m) => ((b -> b) -> a -> a) -> (m b -> m b) -> m a -> m a which, as Daniel pointed out, is impossible. So we start with the isomorphisms: isoL :: (f -> a) -> (a -> f -> f) -> ((a -> a) -> (f -> f)) isoL g s m f = s (m (g f)) f isoR :: (f -> a) -> ((a -> a) -> (f -> f)) -> (a -> f -> f) isoR _ m a = m (const a) It turns out we really only need isoL, but isoR is there for completeness. Then we write: liftALabel :: Applicative f => a :-> b -> f a :-> f b liftALabel l0 = lens g1 m1 where g1 = fmap (get l0) s1 = liftA2 (set l0) m1 = isoL g1 s1 Naturally, monad has been effect-reduced to applicative to admit more legal programs. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon at mintsource.org Fri Dec 11 09:20:24 2015 From: simon at mintsource.org (Simon Peter Nicholls) Date: Fri, 11 Dec 2015 10:20:24 +0100 Subject: [Haskell-beginners] How can I lift my function taking a function to a Monad? In-Reply-To: References: <1449751425.3167.0@smtp.gmail.com> <877fkm9zam.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <1449760600.3167.1@smtp.gmail.com> Message-ID: <1449825624.2873.0@smtp.gmail.com> On Thu, 10 Dec, 2015 at 6:43 PM, Kim-Ee Yeoh wrote: > The wrong way is to try to write: > > neededLift :: (Monad m) => ((b -> b) -> a -> a) -> (m b -> m b) -> m > a -> m a > > which, as Daniel pointed out, is impossible. > > So we start with the isomorphisms: > > isoL :: (f -> a) -> (a -> f -> f) -> ((a -> a) -> (f -> f)) > isoL g s m f = s (m (g f)) f > isoR :: (f -> a) -> ((a -> a) -> (f -> f)) -> (a -> f -> f) > isoR _ m a = m (const a) > > It turns out we really only need isoL, but isoR is there for > completeness. > > Then we write: > > liftALabel :: Applicative f => a :-> b -> f a :-> f b > liftALabel l0 = lens g1 m1 where > g1 = fmap (get l0) > s1 = liftA2 (set l0) > m1 = isoL g1 s1 > > Naturally, monad has been effect-reduced to applicative to admit more > legal programs. > > -- Kim-Ee Thanks guys, I appreciate your help. You've given me a lot of food for thought here, Kim-Ee, and I'll spin off a new project to explore this in isolation. Si -------------- next part -------------- An HTML attachment was scrubbed... URL: From abhishekkmr18 at gmail.com Fri Dec 11 14:47:47 2015 From: abhishekkmr18 at gmail.com (Abhishek Kumar) Date: Fri, 11 Dec 2015 20:17:47 +0530 Subject: [Haskell-beginners] Haskell code optimisation Message-ID: I was trying to write below program for ackerman function but it fails (waits too long) for ack(4,1) whereas a recursive C program gives result in 37secs.Can someone pls explain this behaviour and recomend some optimisation. ------haskell code f m n | m==0 =n+1 | n==0 = f (m-1) 1 | otherwise = f (m-1) (f m (n-1)) Thanks Abhishek Kumar -------------- next part -------------- An HTML attachment was scrubbed... URL: From abhishekkmr18 at gmail.com Fri Dec 11 15:07:19 2015 From: abhishekkmr18 at gmail.com (Abhishek Kumar) Date: Fri, 11 Dec 2015 20:37:19 +0530 Subject: [Haskell-beginners] Doubts about functional programming paradigm Message-ID: I am a beginner in haskell.I have heard a lot about haskell being great for parallel programming and concurrency but couldn't understand why?Aren't iterative algorithms like MapReduce more suitable to run parallely?Also how immutable data structures add to speed?I'm having trouble understanding very philosophy of functional programming, how do we gain by writing everything as functions and pure code(without side effects)? Any links or references will be a great help. Thanks Abhishek Kumar -------------- next part -------------- An HTML attachment was scrubbed... URL: From sanatan at gmail.com Fri Dec 11 15:12:37 2015 From: sanatan at gmail.com (Sanatan Rai) Date: Fri, 11 Dec 2015 15:12:37 +0000 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: I'd recommend writing out some code and then deciding. Functional programming is not a panacea, just the challenges are in different places. Proponents claim that the challenges are in the *right* place. Your mileage might vary. I recommend working through 'Real World Haskell' as a good place to start. --Sanatan On 11 Dec 2015 15:07, "Abhishek Kumar" wrote: > I am a beginner in haskell.I have heard a lot about haskell being great > for parallel programming and concurrency but couldn't understand why?Aren't > iterative algorithms like MapReduce more suitable to run parallely?Also how > immutable data structures add to speed?I'm having trouble understanding > very philosophy of functional programming, how do we gain by writing > everything as functions and pure code(without side effects)? > Any links or references will be a great help. > Thanks > Abhishek Kumar > > _______________________________________________ > 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 sumit.sahrawat.apm13 at iitbhu.ac.in Fri Dec 11 15:14:39 2015 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Fri, 11 Dec 2015 20:44:39 +0530 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: If you're looking to start, I'll recommend the learnhaskell guide: https://github.com/bitemyapp/learnhaskell On 11 December 2015 at 20:42, Sanatan Rai wrote: > I'd recommend writing out some code and then deciding. Functional > programming is not a panacea, just the challenges are in different places. > Proponents claim that the challenges are in the *right* place. Your mileage > might vary. > > I recommend working through 'Real World Haskell' as a good place to start. > > --Sanatan > On 11 Dec 2015 15:07, "Abhishek Kumar" wrote: > >> I am a beginner in haskell.I have heard a lot about haskell being great >> for parallel programming and concurrency but couldn't understand why?Aren't >> iterative algorithms like MapReduce more suitable to run parallely?Also how >> immutable data structures add to speed?I'm having trouble understanding >> very philosophy of functional programming, how do we gain by writing >> everything as functions and pure code(without side effects)? >> Any links or references will be a great help. >> Thanks >> Abhishek Kumar >> >> _______________________________________________ >> 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 > > -- Sumit Sahrawat, Junior - Mathematics and Computing, Indian Institute of Technology - BHU, Varanasi, India -------------- next part -------------- An HTML attachment was scrubbed... URL: From sumit.sahrawat.apm13 at iitbhu.ac.in Fri Dec 11 15:17:12 2015 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Fri, 11 Dec 2015 20:47:12 +0530 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: Graham Hutton's paper "A tutorial on the expressiveness and universality of folds", provides a good introduction to folds, and implements the Ackerman function as an example. Folds were the first stumbling point for me when learning Haskell, and this paper helped me a lot. On 11 December 2015 at 20:17, Abhishek Kumar wrote: > I was trying to write below program for ackerman function but it fails > (waits too long) for ack(4,1) whereas a recursive C program gives result in > 37secs.Can someone pls explain this behaviour and recomend some > optimisation. > > ------haskell code > f m n | m==0 =n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > Thanks > Abhishek Kumar > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Sumit Sahrawat, Junior - Mathematics and Computing, Indian Institute of Technology - BHU, Varanasi, India -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Fri Dec 11 15:28:02 2015 From: imantc at gmail.com (Imants Cekusins) Date: Fri, 11 Dec 2015 16:28:02 +0100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: > parallel programming and concurrency but couldn't understand why? Let's experiment: spread a programming task across large teams. in project A each programmer work on their area but may also change other's code. Programmers also depend on the progress their colleagues' make. in project B each programmer works on their own code with inputs and putputs well defined. There is no dependency on other programmers. Even if you did not work in both scenarios (project A & B), it is probably easy to imagine how both projects could progress. > how immutable data structures add to speed? immutable data structures add to reliability. > what do we gain by writing everything as functions and pure code(without side effects)? pure code gives consistency and allows to split larger programs into parts without fear for end result. From marcoy at gmail.com Fri Dec 11 15:38:14 2015 From: marcoy at gmail.com (Marco Yuen) Date: Fri, 11 Dec 2015 10:38:14 -0500 Subject: [Haskell-beginners] Help with expressing polymorphic return type Message-ID: Hi all, {-# LANGUAGE TypeFamilies #-} data CB = CB deriving (Show) data CO = CO deriving (Show) data CBParseResult = CBParseResult deriving (Show) data COParseResult = COParseResult deriving (Show) class ParseResult a where type EntityType a :: * toEntity :: a -> EntityType a instance ParseResult CBParseResult where type EntityType CBParseResult = CB toEntity result = CB instance ParseResult COParseResult where type EntityType COParseResult = CO toEntity result = CO getParseResult :: (ParseResult r) => String -> IO r getParseResult i = do if someCond then return CBParseResult else return COParseResult where someCond = null i Couldn't match expected type ?r? with actual type ?COParseResult? ?r? is a rigid type variable bound by the type signature for getParseResult :: ParseResult r => String -> IO r at Parse.hs:19:19 Relevant bindings include getParseResult :: String -> IO r (bound at Parse.hs:20:1) In the first argument of ?return?, namely ?COParseResult? In the expression: return COParseResult What I want to express is getParseResult to be able to return any instances of ParseResult type class. But what I understand from the error is that r has been specialized to CBParseResult, but in the next expression I'm returning COParseResult. Is my understanding correct? And, How would I express what I described? Thanks, Marco -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Fri Dec 11 15:44:41 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Fri, 11 Dec 2015 22:44:41 +0700 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: Have you tried BangPatterns? Compiled with optimization, I get 22 secs. Here's the full program: {-# LANGUAGE BangPatterns #-} f :: Int -> Int -> Int f !m !n | m==0 = n+1 | n==0 = f (m-1) 1 | otherwise = f (m-1) (f m (n-1)) main = putStrLn (show (f 4 1)) -- Kim-Ee On Fri, Dec 11, 2015 at 9:47 PM, Abhishek Kumar wrote: > I was trying to write below program for ackerman function but it fails > (waits too long) for ack(4,1) whereas a recursive C program gives result in > 37secs.Can someone pls explain this behaviour and recomend some > optimisation. > > ------haskell code > f m n | m==0 =n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > Thanks > Abhishek Kumar > > _______________________________________________ > 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 bergey at alum.mit.edu Fri Dec 11 16:22:24 2015 From: bergey at alum.mit.edu (Daniel Bergey) Date: Fri, 11 Dec 2015 11:22:24 -0500 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: <874mfp9cqn.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> On 2015-12-11 at 10:07, Abhishek Kumar wrote: > I am a beginner in haskell.I have heard a lot about haskell being great for > parallel programming and concurrency but couldn't understand why?Aren't > iterative algorithms like MapReduce more suitable to run parallely?Also how > immutable data structures add to speed?I'm having trouble understanding > very philosophy of functional programming, how do we gain by writing > everything as functions and pure code(without side effects)? > Any links or references will be a great help. Functional languages make it easy to decompose problems in the way that MapReduce frameworks require. A few examples (fold is another name for reduce): sum :: [Double] -> Double sum xs = foldr (+) 0 xs sumSquares :: [Double] -> Double sumSquares xs = foldr (+) 0 (map (**2) xs) -- foldMap combines the map & fold steps -- The Monoid instance for String specifies how to combine 2 Strings -- Unlike numbers, there's only one consistent option unlines :: [Text] -> Text unlines xs = foldMap (`snoc` '\n') xs We'd need a few changes[1] to make this parallel and distribute across many computers, but expressing the part that changes for each new MapReduce task should stay easy. Immutable data by default helps with concurrency. Speed may or may not be the goal. We want to be able to distribute tasks (eg, function calls) across processor cores, and run them in different order, without introducing race conditions. Simon Marlow's book is great at explaining parallel & concurrent concepts, and the particular tools for applying them in Haskell: http://chimera.labs.oreilly.com/books/1230000000929 bergey Footnotes: [1] OK, many changes. From matthewjwilliams101 at gmail.com Fri Dec 11 18:08:11 2015 From: matthewjwilliams101 at gmail.com (MJ Williams) Date: Fri, 11 Dec 2015 18:08:11 +0000 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: <874mfp9cqn.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <874mfp9cqn.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: A pure functional language enables you to reason about your code, something you can't easily achieve with your average C or Java. And by `reason' I am referring to mathematical proof. Haskell makes it very simple, actually. Why should you want to reason about your code? Think the hassle you could avoid if you knew what your code really meant and did when executed. The absence of side effects is part of another concept in FP, namely, `referential transparency'. If your function `f' maps a value `x' to a value `y' then `f x' will always equal `y' and no more. In other words, your function `f' won't change anything e.g. assign to variables, or other state changes as well as mapping `x' to `y', and that's an absolute certainty, in theory, at any rate. That's a very crude overview of at least part of what functional programming is about. I'm hoping it'll encourage others on this list with far more in-depth knowledge of the subject matter to come in and fill in the gaps and iron out the ambiguities. Matthew On 11/12/2015, Daniel Bergey wrote: > On 2015-12-11 at 10:07, Abhishek Kumar wrote: >> I am a beginner in haskell.I have heard a lot about haskell being great >> for >> parallel programming and concurrency but couldn't understand why?Aren't >> iterative algorithms like MapReduce more suitable to run parallely?Also >> how >> immutable data structures add to speed?I'm having trouble understanding >> very philosophy of functional programming, how do we gain by writing >> everything as functions and pure code(without side effects)? >> Any links or references will be a great help. > > Functional languages make it easy to decompose problems in the way that > MapReduce frameworks require. A few examples (fold is another name for > reduce): > > sum :: [Double] -> Double > sum xs = foldr (+) 0 xs > > sumSquares :: [Double] -> Double > sumSquares xs = foldr (+) 0 (map (**2) xs) > > -- foldMap combines the map & fold steps > -- The Monoid instance for String specifies how to combine 2 Strings > -- Unlike numbers, there's only one consistent option > unlines :: [Text] -> Text > unlines xs = foldMap (`snoc` '\n') xs > > We'd need a few changes[1] to make this parallel and distribute across many > computers, but expressing the part that changes for each new MapReduce > task should stay easy. > > Immutable data by default helps with concurrency. Speed may or may not be > the goal. We want to be able to distribute tasks (eg, function calls) > across processor cores, and run them in different order, without > introducing race conditions. > > Simon Marlow's book is great at explaining parallel & concurrent > concepts, and the particular tools for applying them in Haskell: > http://chimera.labs.oreilly.com/books/1230000000929 > > bergey > > Footnotes: > [1] OK, many changes. > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From tjakway at nyu.edu Fri Dec 11 18:32:55 2015 From: tjakway at nyu.edu (Thomas Jakway) Date: Fri, 11 Dec 2015 13:32:55 -0500 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: Message-ID: <8d5e544f-2ee7-473d-a2bf-5fea3e73fa62@email.android.com> Building on that, I think coming to Haskell with a very specific goal in mind (like swap Haskell for Java in my map reduce problem) kind of misses the point.? Haskell may or may not be faster/better suited to map reduce vs Java, but the real reason to use/learn Haskell is elegance and correctness.? The lack of side effects and referential transparency means you're far more likely to prevent bugs. And there's a pretty substantial learning curve coming from imperative languages so if you need to speed up map reduce on a deadline you will be more productive in the imperative language of your choice (for now). Dont take this as discouragement, I think Haskell (and FP in general) is very well suited to that kind of problem. I'm a beginner in Haskell and it's already had a huge impact on how I think about all the code I write, not just the occasional toy Haskell project. On Dec 11, 2015 1:08 PM, MJ Williams wrote: > > A pure functional language enables you to reason about your code, > something you can't easily achieve with your average C or Java. And by > `reason' I am referring to mathematical proof. Haskell makes it very > simple, actually.? Why should you want to reason about your code? > Think the hassle you could avoid if you knew what your code really > meant and did when executed. > > The absence of side effects is part of another concept in FP, namely, > `referential transparency'.? If your function `f' maps a value `x' to > a value `y' then `f x' will always equal `y' and no more. In other > words, your function `f' won't change anything e.g. assign to > variables, or other state changes as well as mapping `x' to `y', and > that's an absolute certainty, in theory, at any rate. > > That's a very crude overview of at least part of what functional > programming is about.? I'm hoping it'll encourage others on this list > with far more in-depth knowledge of the subject matter to come in and > fill in the gaps and iron out the ambiguities. > > Matthew > > > On 11/12/2015, Daniel Bergey wrote: > > On 2015-12-11 at 10:07, Abhishek Kumar wrote: > >> I am a beginner in haskell.I have heard a lot about haskell being great > >> for > >> parallel programming and concurrency but couldn't understand why?Aren't > >> iterative algorithms like MapReduce more suitable to run parallely?Also > >> how > >> immutable data structures add to speed?I'm having trouble understanding > >> very philosophy of functional programming, how do we gain by writing > >> everything as functions and pure code(without side effects)? > >> Any links or references will be a great help. > > > > Functional languages make it easy to decompose problems in the way that > > MapReduce frameworks require.? A few examples (fold is another name for > > reduce): > > > > sum :: [Double] -> Double > > sum xs = foldr (+) 0 xs > > > > sumSquares :: [Double] -> Double > > sumSquares xs = foldr (+) 0 (map (**2) xs) > > > > -- foldMap combines the map & fold steps > > -- The Monoid instance for String specifies how to combine 2 Strings > > -- Unlike numbers, there's only one consistent option > > unlines :: [Text] -> Text > > unlines xs = foldMap (`snoc` '\n') xs > > > > We'd need a few changes[1] to make this parallel and distribute across many > > computers, but expressing the part that changes for each new MapReduce > > task should stay easy. > > > > Immutable data by default helps with concurrency.? Speed may or may not be > > the goal.? We want to be able to distribute tasks (eg, function calls) > > across processor cores, and run them in different order, without > > introducing race conditions. > > > > Simon Marlow's book is great at explaining parallel & concurrent > > concepts, and the particular tools for applying them in Haskell: > > http://chimera.labs.oreilly.com/books/1230000000929 > > > > bergey > > > > Footnotes: > > [1]? OK, many changes. > > > > _______________________________________________ > > 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 dedgrant at gmail.com Fri Dec 11 21:13:50 2015 From: dedgrant at gmail.com (Darren Grant) Date: Sat, 12 Dec 2015 08:13:50 +1100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Regarding concurrency+immutability with respect to both reliability and performance: One way to think about synchronizing concurrent programs is by sharing memory. If the content of that memory changes, then there is a risk of race conditions arising in the affected programs. (A common source of vexing bugs, and complications for compilers.) But if the contents are somehow guaranteed not to change (ie. a specific definition of immutability), then no race conditions are possible for the lifetime of access to that memory. Although this is a greatly simplified illustrative explanation, it is generally at the heart of arguments for immutability aiding performance. Unchanging regions of memory tend to permit simpler sorts of models since limitations are lifted on synchronization. This in turn allows both more freedom to pursue many otherwise tricky optimizations, such as ex. deciding when to duplicate based on cache geometry, trivially remembering old results, etc. Regarding the discourse on purely functional programs not having side effects: Writing pure programs without side effects is a little tricky to talk about, since this has some very precise technical meanings depending on whom you talk to. (What constitutes an effect? Where is the line between intentional and unintentional drawn?) Maybe think of this statement as part of the continuum of arguments about languages that allow us to write simpler programs that more precisely state the intended effects. Cheers, Darren On Dec 11, 2015 07:07, "Abhishek Kumar" wrote: > I am a beginner in haskell.I have heard a lot about haskell being great > for parallel programming and concurrency but couldn't understand why?Aren't > iterative algorithms like MapReduce more suitable to run parallely?Also how > immutable data structures add to speed?I'm having trouble understanding > very philosophy of functional programming, how do we gain by writing > everything as functions and pure code(without side effects)? > Any links or references will be a great help. > Thanks > Abhishek Kumar > > _______________________________________________ > 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 cma at bitemyapp.com Fri Dec 11 21:36:26 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Fri, 11 Dec 2015 15:36:26 -0600 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Having the option of communicating by sharing memory, message-passing style (copying), or copy-on-write semantics in Haskell programs is why I've found Haskell to be a real pleasure for performance (latency, mostly) sensitive services I frequently work on. I get a superset of options in Haskell for which I don't have any one choice that can really match it in concurrency problems or single-machine parallelism. There's some work to be done to catch up to OTP, but the community is inching its way a few directions (Cloud Haskell/distributed haskell, courier, streaming lib + networking, etc.) Generally I prefer to build out services in a conventional style (breaking out capacities like message backends or persistence into separate machines), but the workers/app servers are all in Haskell. That is, I don't try to replicate the style of cluster you'd see with Erlang services in Haskell, but I know people that have done so and were happy with the result. Being able to have composable concurrency via STM without compromising correctness is _no small thing_ and the cheap threads along with other features of Haskell have served to make it so that concurrency and parallelization of Haskell programs can be a much more modular process than I've experienced in many other programming languages. It makes it so that I can write programs totally oblivious to concurrency or parallelism and then layer different strategies of parallelization or synchronization after the fact, changing them out at runtime if I so desire! This is only possible for me in Haskell because of the non-strict semantics and incredible kit we have at our disposal thanks to the efforts of Simon Marlow and others. Much of this is ably covered in Marlow's book at: http://chimera.labs.oreilly.com/books/1230000000929 Side bar: although using "pure" with respect to effects is the common usage now, I'd urge you to consider finding a different wording since the original (and IMHO more meaningful) denotation of pure functional programming was about semantics and not the presence or absence of effects. The meaning was that you had a programming language whose semantics were lambda-calculus-and-nothing-more. This can be contrasted with ML where the lambda calculus is augmented with an imperative language that isn't functional or a lambda calculus. Part of the problem with making purity about effects rather than semantics is the terrible imprecision confuses new people. They'll often misunderstand it as, "Haskell programs can't perform effects" or they'll think it means stuff in "IO" isn't pure - which is false. We benefit from having a pure functionalal programming language _especially_ in programs that emit effects. Gabriel Gonzalez has a nice article demonstrating some of this: http://www.haskellforall.com/2015/03/algebraic-side-effects.html When I want to talk about effects, I say "effect". When I want to say something that doesn't emit effects, I say "effect-free" and when it does, "effectful". Sometimes I'll say "in IO" for the latter as well, where "in IO" can be any type that has IO in the outermost position of the final return type. But, in the end, I'm not really here to convince anybody to use Haskell. I'm working on http://haskellbook.com/ with my coauthor Julie because I thought it was unreasonably difficult and time-consuming to learn a language that is quite pleasant and productive to use in my day to day work. If Haskell picks up in popularity, cool - more libraries! If not, then it remains an uncommon and not well-understood competitive advantage in my work. I'm not sure I mind either outcome as long as the community doesn't contract and it seems to be doing the opposite of that lately. I use Haskell because I'm lazy and impatient. I do not tolerate tedious, preventable work well. Haskell lets me break down my problems into digestible units, it forces the APIs I consume to declare what chicanery they're up to, it gives me the nicest kit for my work I've ever had at my disposal. It's not perfect - it's best if you're comfortable with a unix-y toolkit, but there's Haskellers on Windows keeping the lights on too. Best of luck to Abhishek whatever they decide to do from here. I won't pretend Haskell is "easy" - you have to learn more before you can write the typical software project, but it's an upfront cliff sorta thing that converts into a long-term advantage if you're willing to do the work. This is more the case than what I found with Clojure, Erlang, Java, C++, Go, etc. They all have a gentler upfront productivity cliff, but don't pay off nearly as well long-term in my experience. YMMV. On Fri, Dec 11, 2015 at 3:13 PM, Darren Grant wrote: > Regarding concurrency+immutability with respect to both reliability and > performance: > > One way to think about synchronizing concurrent programs is by sharing > memory. If the content of that memory changes, then there is a risk of race > conditions arising in the affected programs. (A common source of vexing > bugs, and complications for compilers.) But if the contents are somehow > guaranteed not to change (ie. a specific definition of immutability), then > no race conditions are possible for the lifetime of access to that memory. > > Although this is a greatly simplified illustrative explanation, it is > generally at the heart of arguments for immutability aiding performance. > Unchanging regions of memory tend to permit simpler sorts of models since > limitations are lifted on synchronization. This in turn allows both more > freedom to pursue many otherwise tricky optimizations, such as ex. deciding > when to duplicate based on cache geometry, trivially remembering old > results, etc. > > Regarding the discourse on purely functional programs not having side > effects: > > Writing pure programs without side effects is a little tricky to talk > about, since this has some very precise technical meanings depending on > whom you talk to. (What constitutes an effect? Where is the line between > intentional and unintentional drawn?) > > Maybe think of this statement as part of the continuum of arguments about > languages that allow us to write simpler programs that more precisely state > the intended effects. > > Cheers, > Darren > On Dec 11, 2015 07:07, "Abhishek Kumar" wrote: > >> I am a beginner in haskell.I have heard a lot about haskell being great >> for parallel programming and concurrency but couldn't understand why?Aren't >> iterative algorithms like MapReduce more suitable to run parallely?Also how >> immutable data structures add to speed?I'm having trouble understanding >> very philosophy of functional programming, how do we gain by writing >> everything as functions and pure code(without side effects)? >> Any links or references will be a great help. >> Thanks >> Abhishek Kumar >> >> _______________________________________________ >> 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 > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewjwilliams101 at gmail.com Sat Dec 12 00:45:53 2015 From: matthewjwilliams101 at gmail.com (MJ Williams) Date: Sat, 12 Dec 2015 00:45:53 +0000 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: What is a `race condition'? On 11/12/2015, Christopher Allen wrote: > Having the option of communicating by sharing memory, message-passing style > (copying), or copy-on-write semantics in Haskell programs is why I've found > Haskell to be a real pleasure for performance (latency, mostly) sensitive > services I frequently work on. I get a superset of options in Haskell for > which I don't have any one choice that can really match it in concurrency > problems or single-machine parallelism. There's some work to be done to > catch up to OTP, but the community is inching its way a few directions > (Cloud Haskell/distributed haskell, courier, streaming lib + networking, > etc.) > > Generally I prefer to build out services in a conventional style (breaking > out capacities like message backends or persistence into separate > machines), but the workers/app servers are all in Haskell. That is, I don't > try to replicate the style of cluster you'd see with Erlang services in > Haskell, but I know people that have done so and were happy with the > result. Being able to have composable concurrency via STM without > compromising correctness is _no small thing_ and the cheap threads along > with other features of Haskell have served to make it so that concurrency > and parallelization of Haskell programs can be a much more modular process > than I've experienced in many other programming languages. It makes it so > that I can write programs totally oblivious to concurrency or parallelism > and then layer different strategies of parallelization or synchronization > after the fact, changing them out at runtime if I so desire! This is only > possible for me in Haskell because of the non-strict semantics and > incredible kit we have at our disposal thanks to the efforts of Simon > Marlow and others. Much of this is ably covered in Marlow's book at: > http://chimera.labs.oreilly.com/books/1230000000929 > > Side bar: although using "pure" with respect to effects is the common usage > now, I'd urge you to consider finding a different wording since the > original (and IMHO more meaningful) denotation of pure functional > programming was about semantics and not the presence or absence of effects. > The meaning was that you had a programming language whose semantics were > lambda-calculus-and-nothing-more. This can be contrasted with ML where the > lambda calculus is augmented with an imperative language that isn't > functional or a lambda calculus. Part of the problem with making purity > about effects rather than semantics is the terrible imprecision confuses > new people. They'll often misunderstand it as, "Haskell programs can't > perform effects" or they'll think it means stuff in "IO" isn't pure - which > is false. We benefit from having a pure functionalal programming language > _especially_ in programs that emit effects. Gabriel Gonzalez has a nice > article demonstrating some of this: > http://www.haskellforall.com/2015/03/algebraic-side-effects.html > > When I want to talk about effects, I say "effect". When I want to say > something that doesn't emit effects, I say "effect-free" and when it does, > "effectful". Sometimes I'll say "in IO" for the latter as well, where "in > IO" can be any type that has IO in the outermost position of the final > return type. > > But, in the end, I'm not really here to convince anybody to use Haskell. > I'm working on http://haskellbook.com/ with my coauthor Julie because I > thought it was unreasonably difficult and time-consuming to learn a > language that is quite pleasant and productive to use in my day to day > work. If Haskell picks up in popularity, cool - more libraries! If not, > then it remains an uncommon and not well-understood competitive advantage > in my work. I'm not sure I mind either outcome as long as the community > doesn't contract and it seems to be doing the opposite of that lately. > > I use Haskell because I'm lazy and impatient. I do not tolerate tedious, > preventable work well. Haskell lets me break down my problems into > digestible units, it forces the APIs I consume to declare what chicanery > they're up to, it gives me the nicest kit for my work I've ever had at my > disposal. It's not perfect - it's best if you're comfortable with a unix-y > toolkit, but there's Haskellers on Windows keeping the lights on too. > > Best of luck to Abhishek whatever they decide to do from here. I won't > pretend Haskell is "easy" - you have to learn more before you can write the > typical software project, but it's an upfront cliff sorta thing that > converts into a long-term advantage if you're willing to do the work. This > is more the case than what I found with Clojure, Erlang, Java, C++, Go, > etc. They all have a gentler upfront productivity cliff, but don't pay off > nearly as well long-term in my experience. YMMV. > > On Fri, Dec 11, 2015 at 3:13 PM, Darren Grant wrote: > >> Regarding concurrency+immutability with respect to both reliability and >> performance: >> >> One way to think about synchronizing concurrent programs is by sharing >> memory. If the content of that memory changes, then there is a risk of >> race >> conditions arising in the affected programs. (A common source of vexing >> bugs, and complications for compilers.) But if the contents are somehow >> guaranteed not to change (ie. a specific definition of immutability), >> then >> no race conditions are possible for the lifetime of access to that >> memory. >> >> Although this is a greatly simplified illustrative explanation, it is >> generally at the heart of arguments for immutability aiding performance. >> Unchanging regions of memory tend to permit simpler sorts of models since >> limitations are lifted on synchronization. This in turn allows both more >> freedom to pursue many otherwise tricky optimizations, such as ex. >> deciding >> when to duplicate based on cache geometry, trivially remembering old >> results, etc. >> >> Regarding the discourse on purely functional programs not having side >> effects: >> >> Writing pure programs without side effects is a little tricky to talk >> about, since this has some very precise technical meanings depending on >> whom you talk to. (What constitutes an effect? Where is the line between >> intentional and unintentional drawn?) >> >> Maybe think of this statement as part of the continuum of arguments about >> languages that allow us to write simpler programs that more precisely >> state >> the intended effects. >> >> Cheers, >> Darren >> On Dec 11, 2015 07:07, "Abhishek Kumar" wrote: >> >>> I am a beginner in haskell.I have heard a lot about haskell being great >>> for parallel programming and concurrency but couldn't understand >>> why?Aren't >>> iterative algorithms like MapReduce more suitable to run parallely?Also >>> how >>> immutable data structures add to speed?I'm having trouble understanding >>> very philosophy of functional programming, how do we gain by writing >>> everything as functions and pure code(without side effects)? >>> Any links or references will be a great help. >>> Thanks >>> Abhishek Kumar >>> >>> _______________________________________________ >>> 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 >> >> > > > -- > Chris Allen > Currently working on http://haskellbook.com > From defigueiredo at ucdavis.edu Sat Dec 12 00:56:48 2015 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Fri, 11 Dec 2015 22:56:48 -0200 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: <566B70D0.8070603@ucdavis.edu> +1 for composable concurrency through STM. It multiplies programmer effectiveness many times when doing concurrent programming. I now consider threads, condition variables and locks "cruel and unusual punishment". However, the learning curve in Haskell is not a small problem. It is *the* crucial problem with the language. I believe it is exactly what will prevent the language for becoming mainstream in the foreseeable future (e.g. 10 years). Consider a snippet of an error message from GHC that previously appeared in this list Couldn't match expected type ?r? with actual type ?COParseResult? ?r? is a rigid type variable bound by the type signature for getParseResult :: ParseResult r => String -> IO r ... I have a PhD in computer science, but never really liked programming languages back then and somehow I never learned what a "rigid type variable" is. I was happily chugging along until I came to haskell and was confronted with this error message. Does one have to be a type theorist to make sense of this error message? Strictly speaking, I am complaining about GHC not haskell. But would anyone care to explain to a novice in a couple paragraphs why foldl (+) 0 [1..10^9] may take 10 Gigs of RAM to calculate? My advice to anyone who wants to learn haskell is to join social groups as we are not yet ready to teach it through books. I frequently have to go read academic papers to learn new topics. That shows me that the knowledge used to build the language simply has not been digested enough to be easily accessible to the average programmer. Summarizing, Learning Haskell: It will be a bumpy ride, but there *is* a happy ending. Cheers, Dimitri On 12/11/15 7:36 PM, Christopher Allen wrote: > Having the option of communicating by sharing memory, message-passing > style (copying), or copy-on-write semantics in Haskell programs is why > I've found Haskell to be a real pleasure for performance (latency, > mostly) sensitive services I frequently work on. I get a superset of > options in Haskell for which I don't have any one choice that can > really match it in concurrency problems or single-machine parallelism. > There's some work to be done to catch up to OTP, but the community is > inching its way a few directions (Cloud Haskell/distributed haskell, > courier, streaming lib + networking, etc.) > > Generally I prefer to build out services in a conventional style > (breaking out capacities like message backends or persistence into > separate machines), but the workers/app servers are all in Haskell. > That is, I don't try to replicate the style of cluster you'd see with > Erlang services in Haskell, but I know people that have done so and > were happy with the result. Being able to have composable concurrency > via STM without compromising correctness is _no small thing_ and the > cheap threads along with other features of Haskell have served to make > it so that concurrency and parallelization of Haskell programs can be > a much more modular process than I've experienced in many other > programming languages. It makes it so that I can write programs > totally oblivious to concurrency or parallelism and then layer > different strategies of parallelization or synchronization after the > fact, changing them out at runtime if I so desire! This is only > possible for me in Haskell because of the non-strict semantics and > incredible kit we have at our disposal thanks to the efforts of Simon > Marlow and others. Much of this is ably covered in Marlow's book at: > http://chimera.labs.oreilly.com/books/1230000000929 > > Side bar: although using "pure" with respect to effects is the common > usage now, I'd urge you to consider finding a different wording since > the original (and IMHO more meaningful) denotation of pure functional > programming was about semantics and not the presence or absence of > effects. The meaning was that you had a programming language whose > semantics were lambda-calculus-and-nothing-more. This can be > contrasted with ML where the lambda calculus is augmented with an > imperative language that isn't functional or a lambda calculus. Part > of the problem with making purity about effects rather than semantics > is the terrible imprecision confuses new people. They'll often > misunderstand it as, "Haskell programs can't perform effects" or > they'll think it means stuff in "IO" isn't pure - which is false. We > benefit from having a pure functionalal programming language > _especially_ in programs that emit effects. Gabriel Gonzalez has a > nice article demonstrating some of this: > http://www.haskellforall.com/2015/03/algebraic-side-effects.html > > When I want to talk about effects, I say "effect". When I want to say > something that doesn't emit effects, I say "effect-free" and when it > does, "effectful". Sometimes I'll say "in IO" for the latter as well, > where "in IO" can be any type that has IO in the outermost position of > the final return type. > > But, in the end, I'm not really here to convince anybody to use > Haskell. I'm working on http://haskellbook.com/ with my coauthor Julie > because I thought it was unreasonably difficult and time-consuming to > learn a language that is quite pleasant and productive to use in my > day to day work. If Haskell picks up in popularity, cool - more > libraries! If not, then it remains an uncommon and not well-understood > competitive advantage in my work. I'm not sure I mind either outcome > as long as the community doesn't contract and it seems to be doing the > opposite of that lately. > > I use Haskell because I'm lazy and impatient. I do not tolerate > tedious, preventable work well. Haskell lets me break down my problems > into digestible units, it forces the APIs I consume to declare what > chicanery they're up to, it gives me the nicest kit for my work I've > ever had at my disposal. It's not perfect - it's best if you're > comfortable with a unix-y toolkit, but there's Haskellers on Windows > keeping the lights on too. > > Best of luck to Abhishek whatever they decide to do from here. I won't > pretend Haskell is "easy" - you have to learn more before you can > write the typical software project, but it's an upfront cliff sorta > thing that converts into a long-term advantage if you're willing to do > the work. This is more the case than what I found with Clojure, > Erlang, Java, C++, Go, etc. They all have a gentler upfront > productivity cliff, but don't pay off nearly as well long-term in my > experience. YMMV. > > On Fri, Dec 11, 2015 at 3:13 PM, Darren Grant > wrote: > > Regarding concurrency+immutability with respect to both > reliability and performance: > > One way to think about synchronizing concurrent programs is by > sharing memory. If the content of that memory changes, then there > is a risk of race conditions arising in the affected programs. (A > common source of vexing bugs, and complications for compilers.) > But if the contents are somehow guaranteed not to change (ie. a > specific definition of immutability), then no race conditions are > possible for the lifetime of access to that memory. > > Although this is a greatly simplified illustrative explanation, it > is generally at the heart of arguments for immutability aiding > performance. Unchanging regions of memory tend to permit simpler > sorts of models since limitations are lifted on synchronization. > This in turn allows both more freedom to pursue many otherwise > tricky optimizations, such as ex. deciding when to duplicate based > on cache geometry, trivially remembering old results, etc. > > Regarding the discourse on purely functional programs not having > side effects: > > Writing pure programs without side effects is a little tricky to > talk about, since this has some very precise technical meanings > depending on whom you talk to. (What constitutes an effect? Where > is the line between intentional and unintentional drawn?) > > Maybe think of this statement as part of the continuum of > arguments about languages that allow us to write simpler programs > that more precisely state the intended effects. > > Cheers, > Darren > > On Dec 11, 2015 07:07, "Abhishek Kumar" > wrote: > > I am a beginner in haskell.I have heard a lot about haskell > being great for parallel programming and concurrency but > couldn't understand why?Aren't iterative algorithms like > MapReduce more suitable to run parallely?Also how immutable > data structures add to speed?I'm having trouble understanding > very philosophy of functional programming, how do we gain by > writing everything as functions and pure code(without side > effects)? > Any links or references will be a great help. > Thanks > Abhishek Kumar > > _______________________________________________ > 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 > > > > > -- > Chris Allen > Currently working on http://haskellbook.com > > > _______________________________________________ > 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 strombrg at gmail.com Sat Dec 12 00:58:25 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Fri, 11 Dec 2015 16:58:25 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Two or more code units want to do basically the same thing at almost the same moment. Whichever one does the thing first (or sometimes, second) wins, and the other loses. EG, imagine two processes communicating over shared memory. If they both want to write to variable x in shared memory at almost the same moment, whichever one writes second "wins", because the write of the first is wiped out by the write of the second. Some race conditions aren't much of a problem, but some of them can be a source of really hard-to-track-down bugs. On Fri, Dec 11, 2015 at 4:45 PM, MJ Williams wrote: > What is a `race condition'? > > On 11/12/2015, Christopher Allen wrote: > > Having the option of communicating by sharing memory, message-passing > style > > (copying), or copy-on-write semantics in Haskell programs is why I've > found > > Haskell to be a real pleasure for performance (latency, mostly) sensitive > > services I frequently work on. I get a superset of options in Haskell for > > which I don't have any one choice that can really match it in concurrency > > problems or single-machine parallelism. There's some work to be done to > > catch up to OTP, but the community is inching its way a few directions > > (Cloud Haskell/distributed haskell, courier, streaming lib + networking, > > etc.) > > > > Generally I prefer to build out services in a conventional style > (breaking > > out capacities like message backends or persistence into separate > > machines), but the workers/app servers are all in Haskell. That is, I > don't > > try to replicate the style of cluster you'd see with Erlang services in > > Haskell, but I know people that have done so and were happy with the > > result. Being able to have composable concurrency via STM without > > compromising correctness is _no small thing_ and the cheap threads along > > with other features of Haskell have served to make it so that concurrency > > and parallelization of Haskell programs can be a much more modular > process > > than I've experienced in many other programming languages. It makes it so > > that I can write programs totally oblivious to concurrency or parallelism > > and then layer different strategies of parallelization or synchronization > > after the fact, changing them out at runtime if I so desire! This is only > > possible for me in Haskell because of the non-strict semantics and > > incredible kit we have at our disposal thanks to the efforts of Simon > > Marlow and others. Much of this is ably covered in Marlow's book at: > > http://chimera.labs.oreilly.com/books/1230000000929 > > > > Side bar: although using "pure" with respect to effects is the common > usage > > now, I'd urge you to consider finding a different wording since the > > original (and IMHO more meaningful) denotation of pure functional > > programming was about semantics and not the presence or absence of > effects. > > The meaning was that you had a programming language whose semantics were > > lambda-calculus-and-nothing-more. This can be contrasted with ML where > the > > lambda calculus is augmented with an imperative language that isn't > > functional or a lambda calculus. Part of the problem with making purity > > about effects rather than semantics is the terrible imprecision confuses > > new people. They'll often misunderstand it as, "Haskell programs can't > > perform effects" or they'll think it means stuff in "IO" isn't pure - > which > > is false. We benefit from having a pure functionalal programming language > > _especially_ in programs that emit effects. Gabriel Gonzalez has a nice > > article demonstrating some of this: > > http://www.haskellforall.com/2015/03/algebraic-side-effects.html > > > > When I want to talk about effects, I say "effect". When I want to say > > something that doesn't emit effects, I say "effect-free" and when it > does, > > "effectful". Sometimes I'll say "in IO" for the latter as well, where "in > > IO" can be any type that has IO in the outermost position of the final > > return type. > > > > But, in the end, I'm not really here to convince anybody to use Haskell. > > I'm working on http://haskellbook.com/ with my coauthor Julie because I > > thought it was unreasonably difficult and time-consuming to learn a > > language that is quite pleasant and productive to use in my day to day > > work. If Haskell picks up in popularity, cool - more libraries! If not, > > then it remains an uncommon and not well-understood competitive advantage > > in my work. I'm not sure I mind either outcome as long as the community > > doesn't contract and it seems to be doing the opposite of that lately. > > > > I use Haskell because I'm lazy and impatient. I do not tolerate tedious, > > preventable work well. Haskell lets me break down my problems into > > digestible units, it forces the APIs I consume to declare what chicanery > > they're up to, it gives me the nicest kit for my work I've ever had at my > > disposal. It's not perfect - it's best if you're comfortable with a > unix-y > > toolkit, but there's Haskellers on Windows keeping the lights on too. > > > > Best of luck to Abhishek whatever they decide to do from here. I won't > > pretend Haskell is "easy" - you have to learn more before you can write > the > > typical software project, but it's an upfront cliff sorta thing that > > converts into a long-term advantage if you're willing to do the work. > This > > is more the case than what I found with Clojure, Erlang, Java, C++, Go, > > etc. They all have a gentler upfront productivity cliff, but don't pay > off > > nearly as well long-term in my experience. YMMV. > > > > On Fri, Dec 11, 2015 at 3:13 PM, Darren Grant > wrote: > > > >> Regarding concurrency+immutability with respect to both reliability and > >> performance: > >> > >> One way to think about synchronizing concurrent programs is by sharing > >> memory. If the content of that memory changes, then there is a risk of > >> race > >> conditions arising in the affected programs. (A common source of vexing > >> bugs, and complications for compilers.) But if the contents are somehow > >> guaranteed not to change (ie. a specific definition of immutability), > >> then > >> no race conditions are possible for the lifetime of access to that > >> memory. > >> > >> Although this is a greatly simplified illustrative explanation, it is > >> generally at the heart of arguments for immutability aiding performance. > >> Unchanging regions of memory tend to permit simpler sorts of models > since > >> limitations are lifted on synchronization. This in turn allows both more > >> freedom to pursue many otherwise tricky optimizations, such as ex. > >> deciding > >> when to duplicate based on cache geometry, trivially remembering old > >> results, etc. > >> > >> Regarding the discourse on purely functional programs not having side > >> effects: > >> > >> Writing pure programs without side effects is a little tricky to talk > >> about, since this has some very precise technical meanings depending on > >> whom you talk to. (What constitutes an effect? Where is the line between > >> intentional and unintentional drawn?) > >> > >> Maybe think of this statement as part of the continuum of arguments > about > >> languages that allow us to write simpler programs that more precisely > >> state > >> the intended effects. > >> > >> Cheers, > >> Darren > >> On Dec 11, 2015 07:07, "Abhishek Kumar" > wrote: > >> > >>> I am a beginner in haskell.I have heard a lot about haskell being great > >>> for parallel programming and concurrency but couldn't understand > >>> why?Aren't > >>> iterative algorithms like MapReduce more suitable to run parallely?Also > >>> how > >>> immutable data structures add to speed?I'm having trouble understanding > >>> very philosophy of functional programming, how do we gain by writing > >>> everything as functions and pure code(without side effects)? > >>> Any links or references will be a great help. > >>> Thanks > >>> Abhishek Kumar > >>> > >>> _______________________________________________ > >>> 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 > >> > >> > > > > > > -- > > Chris Allen > > Currently working on http://haskellbook.com > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sat Dec 12 01:03:43 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 12 Dec 2015 02:03:43 +0100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: > What is a `race condition'? Multiple threads accessing and modifying shared resource (value) in uncontrolled order, which may differ each time code runs. -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewjwilliams101 at gmail.com Sat Dec 12 01:07:49 2015 From: matthewjwilliams101 at gmail.com (MJ Williams) Date: Sat, 12 Dec 2015 01:07:49 +0000 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Just out of interest, what was your PHD in? On 12/12/2015, Imants Cekusins wrote: >> What is a `race condition'? > > Multiple threads accessing and modifying shared resource (value) in > uncontrolled order, which may differ each time code runs. > From ky3 at atamo.com Sat Dec 12 04:10:45 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Sat, 12 Dec 2015 11:10:45 +0700 Subject: [Haskell-beginners] foldr, Foldable and right-side folding In-Reply-To: <87d1uk9s4s.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <87d1uk9s4s.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: On Sun, Dec 6, 2015 at 10:24 AM, Daniel Bergey wrote: > data Li a = Nil | Cons a (Li a) > > deriving (Show) > > > > instance Foldable Li where > > foldr f b Nil = b > > foldr f b (Cons a y) = foldr f (f a b) y > > > > So I'm trying out foldr for my type: > >> foldr Cons Nil (Cons 1 (Cons 2 Nil)) > > Cons 2 (Cons 1 Nil) > > > > This shows my foldr implementation i'm not folding from right side, > > but how can I possibly do that - the data could have been an infinite > > stream. > > A right fold on an infinite stream can terminate if the function f > sometimes discards it's second argument. For example, takeWhile can be > implemented this way. > > You are right that `foldr Cons Nil` or `foldr (:) []` will not terminate > on an infinite list. It's slightly misleading to say: `foldr (:) []` -- call it the foo fold -- will not terminate on an infinite list. It suggests that folds normally terminate on an infinite list whereas this one doesn't, with the implied meaning that the foo fold is "defective" in some sense. Fact is, the foo fold is perfectly cromulent. It's equivalent to the identity function on both finite and infinite lists. So the foo fold doesn't terminate on an infinite list because -- well, duh -- the infinite list doesn't terminate. Also not all folds are designed to terminate. E.g. a list map makes sense even for infinite lists. A list map can be written as a fold. Such a fold wouldn't terminate either. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From abhishekkmr18 at gmail.com Sat Dec 12 09:19:58 2015 From: abhishekkmr18 at gmail.com (Abhishek Kumar) Date: Sat, 12 Dec 2015 14:49:58 +0530 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: Thanks Kim for your answer but as far as I understand strict evaluation should save in space as expression is not expanded in terms of thunks,but I can't understand time savings.Can you pls explain strict evaluation? On Friday, December 11, 2015, Kim-Ee wrote: > Have you tried BangPatterns? Compiled with optimization, I get 22 secs. > Here's the full program: > > {-# LANGUAGE BangPatterns #-} > > f :: Int -> Int -> Int > f !m !n > | m==0 = n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > main = putStrLn (show (f 4 1)) > > > -- Kim-Ee > > On Fri, Dec 11, 2015 at 9:47 PM, Abhishek Kumar > wrote: > >> I was trying to write below program for ackerman function but it fails >> (waits too long) for ack(4,1) whereas a recursive C program gives result in >> 37secs.Can someone pls explain this behaviour and recomend some >> optimisation. >> >> ------haskell code >> f m n | m==0 =n+1 >> | n==0 = f (m-1) 1 >> | otherwise = f (m-1) (f m (n-1)) >> >> Thanks >> Abhishek Kumar >> >> _______________________________________________ >> 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 Sat Dec 12 11:41:19 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Sat, 12 Dec 2015 18:41:19 +0700 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: On Sat, Dec 12, 2015 at 4:19 PM, Abhishek Kumar wrote: > Thanks Kim for your answer but as far as I understand strict evaluation > should save in space as expression is not expanded in terms of thunks,but I > can't understand time savings.Can you pls explain strict evaluation? For this particular problem, start here: https://en.wikipedia.org/wiki/Memory_hierarchy What happens to original program that has a sprawling mass of thunks all over RAM? The CPU spends most of its time waiting on the memory bus. And that's not even going into things like disk-backed virtual mem. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From abhishekkmr18 at gmail.com Sat Dec 12 12:35:25 2015 From: abhishekkmr18 at gmail.com (Abhishek Kumar) Date: Sat, 12 Dec 2015 18:05:25 +0530 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: Compiling below code (ghc --make) still doesn't gives result on my i3 Ubuntu 64bit machine.Can u please elaborate optimisations you did? Thanks Abhishek On Friday, December 11, 2015, Kim-Ee Yeoh wrote: > Have you tried BangPatterns? Compiled with optimization, I get 22 secs. > Here's the full program: > > {-# LANGUAGE BangPatterns #-} > > f :: Int -> Int -> Int > f !m !n > | m==0 = n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > main = putStrLn (show (f 4 1)) > > > -- Kim-Ee > > On Fri, Dec 11, 2015 at 9:47 PM, Abhishek Kumar > wrote: > >> I was trying to write below program for ackerman function but it fails >> (waits too long) for ack(4,1) whereas a recursive C program gives result in >> 37secs.Can someone pls explain this behaviour and recomend some >> optimisation. >> >> ------haskell code >> f m n | m==0 =n+1 >> | n==0 = f (m-1) 1 >> | otherwise = f (m-1) (f m (n-1)) >> >> Thanks >> Abhishek Kumar >> >> _______________________________________________ >> 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 defigueiredo at ucdavis.edu Sat Dec 12 12:57:11 2015 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Sat, 12 Dec 2015 10:57:11 -0200 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: <566C19A7.6070407@ucdavis.edu> with 'ghc -O2' this takes 14 seconds on my macbook pro. Dimitri On 12/12/15 10:35 AM, Abhishek Kumar wrote: > Compiling below code (ghc --make) still doesn't gives result on my i3 > Ubuntu 64bit machine.Can u please elaborate optimisations you did? > Thanks > Abhishek > > On Friday, December 11, 2015, Kim-Ee Yeoh > wrote: > > Have you tried BangPatterns? Compiled with optimization, I get 22 > secs. Here's the full program: > > {-# LANGUAGE BangPatterns #-} > > f :: Int -> Int -> Int > f !m !n > | m==0 = n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > main = putStrLn (show (f 4 1)) > > > -- Kim-Ee > > On Fri, Dec 11, 2015 at 9:47 PM, Abhishek Kumar > > wrote: > > I was trying to write below program for ackerman function but > it fails (waits too long) for ack(4,1) whereas a recursive C > program gives result in 37secs.Can someone pls explain this > behaviour and recomend some optimisation. > > ------haskell code > f m n | m==0 =n+1 > | n==0 = f (m-1) 1 > | otherwise = f (m-1) (f m (n-1)) > > Thanks > Abhishek Kumar > > _______________________________________________ > 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 bergey at alum.mit.edu Sat Dec 12 13:38:44 2015 From: bergey at alum.mit.edu (Daniel Bergey) Date: Sat, 12 Dec 2015 08:38:44 -0500 Subject: [Haskell-beginners] explaining effects (was: Doubts about functional programming paradigm) In-Reply-To: References: Message-ID: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> I have pedagogical questions. Why do you prefer "effect" to "side effect"? I know that "pure" is misleading to programmers new to Haskell, but I have thought that "side effect" was more likely to be self-explanatory. I also reach for longer phrases like "free from side effects" if I'm talking to my students. cheers, bergey On 2015-12-11 at 16:36, Christopher Allen wrote: > Side bar: although using "pure" with respect to effects is the common usage > now, I'd urge you to consider finding a different wording since the > original (and IMHO more meaningful) denotation of pure functional > programming was about semantics and not the presence or absence of effects. > The meaning was that you had a programming language whose semantics were > lambda-calculus-and-nothing-more. This can be contrasted with ML where the > lambda calculus is augmented with an imperative language that isn't > functional or a lambda calculus. Part of the problem with making purity > about effects rather than semantics is the terrible imprecision confuses > new people. They'll often misunderstand it as, "Haskell programs can't > perform effects" or they'll think it means stuff in "IO" isn't pure - which > is false. We benefit from having a pure functionalal programming language > _especially_ in programs that emit effects. Gabriel Gonzalez has a nice > article demonstrating some of this: > http://www.haskellforall.com/2015/03/algebraic-side-effects.html > > When I want to talk about effects, I say "effect". When I want to say > something that doesn't emit effects, I say "effect-free" and when it does, > "effectful". Sometimes I'll say "in IO" for the latter as well, where "in > IO" can be any type that has IO in the outermost position of the final > return type. From limdauto at gmail.com Sat Dec 12 20:29:24 2015 From: limdauto at gmail.com (Lim H.) Date: Sun, 13 Dec 2015 03:29:24 +0700 Subject: [Haskell-beginners] Trouble understanding the type of sequence [Just, Just] Message-ID: Hi everyone, Sorry if this email disturbs you. I haven't used a developer's mailing list before so I'm not sure if I'm violating any etiquette. If I do, please excuse me. I'm trying to understand the type of sequence [Just, Just]. I can understand sequence [Just 1, Just 2] :: Num a => Maybe [a] because when looking at the type of sequence sequence :: (Monad m, Traversable t) => t (m a) -> m (t a) it is clear that this function takes a collection of monadic values and return a single monadic value of the collection. Thus, when we call sequence [Just 1, Just 2] we should get back a Just of [1,2]. Following that train of thoughts, shouldn't sequence [Just, Just] return a single Just? Here is the corresponding SO question http://stackoverflow.com/questions/34244574/trouble-understanding-the-type-of-sequence-just-just Lim -------------- next part -------------- An HTML attachment was scrubbed... URL: From mihai.maruseac at gmail.com Sat Dec 12 20:36:18 2015 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Sat, 12 Dec 2015 15:36:18 -0500 Subject: [Haskell-beginners] Trouble understanding the type of sequence [Just, Just] In-Reply-To: References: Message-ID: Hi, Maybe is a type and Just is one of it's constructors (the other being Nothing): > data Maybe a = Just a | Nothing On Sat, Dec 12, 2015 at 3:29 PM, Lim H. wrote: > Hi everyone, > > Sorry if this email disturbs you. I haven't used a developer's mailing list > before so I'm not sure if I'm violating any etiquette. If I do, please > excuse me. > > I'm trying to understand the type of sequence [Just, Just]. I can understand > sequence [Just 1, Just 2] :: Num a => Maybe [a] > > because when looking at the type of sequence > > sequence :: (Monad m, Traversable t) => t (m a) -> m (t a) > > it is clear that this function takes a collection of monadic values and > return a single monadic value of the collection. Thus, when we call sequence > [Just 1, Just 2] we should get back a Just of [1,2]. Following that train of > thoughts, shouldn't sequence [Just, Just] return a single Just? > > Here is the corresponding SO question > > http://stackoverflow.com/questions/34244574/trouble-understanding-the-type-of-sequence-just-just > > Lim > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From chas at chas.io Sat Dec 12 20:43:25 2015 From: chas at chas.io (Chas Leichner) Date: Sat, 12 Dec 2015 12:43:25 -0800 Subject: [Haskell-beginners] Trouble understanding the type of sequence [Just, Just] In-Reply-To: References: Message-ID: The type of just is (a -> Maybe a) so your list has type [a -> Maybe a] which means the Monad instance that sequence is using isn't Maybe, it's (a ->), the type constructor for function types with its first parameter partially applied. This means that the type of sequence specialized to this context uses [] for t, the Traversable and (a ->) for m, the Monad. That is to say sequence :: [a -> Maybe a] -> (a -> [Maybe a]). (a ->) is one way of representing the Reader monad so you can treat its a parameter as a context that computations can run inside. That means that sequence [Just, Just] takes two functions that construct a Maybe value from the value in the context and turns it into a function which constructs a list of Maybe values each one fed from the same context. That is to say that (sequence [Just, Just] $ 4) == [Just 4, Just 4]. On Saturday, December 12, 2015, Lim H. wrote: > Hi everyone, > > Sorry if this email disturbs you. I haven't used a developer's mailing > list before so I'm not sure if I'm violating any etiquette. If I do, please > excuse me. > > I'm trying to understand the type of sequence [Just, Just]. I can > understand > sequence [Just 1, Just 2] :: Num a => Maybe [a] > > because when looking at the type of sequence > > sequence :: (Monad m, Traversable t) => t (m a) -> m (t a) > > it is clear that this function takes a collection of monadic values and > return a single monadic value of the collection. Thus, when we call sequence > [Just 1, Just 2] we should get back a Just of [1,2]. Following that train > of thoughts, shouldn't sequence [Just, Just] return a single Just? > Here is the corresponding SO question > > > http://stackoverflow.com/questions/34244574/trouble-understanding-the-type-of-sequence-just-just > > Lim > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sat Dec 12 21:07:18 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 12 Dec 2015 22:07:18 +0100 Subject: [Haskell-beginners] Trouble understanding the type of sequence [Just, Just] In-Reply-To: References: Message-ID: > when we call sequence [Just 1, Just 2] we should get back a Just of [1,2]. Following that train of thoughts, shouldn't sequence [Just, Just] return a single Just? What would sequence [Just 1, Nothing] return in this case? Just 1 and Nothing are of the same type - they must be: they are part of the same list. -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sun Dec 13 17:14:29 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 13 Dec 2015 18:14:29 +0100 Subject: [Haskell-beginners] basic State Monad Message-ID: This snippet increments integer n times using state monad. How to call: main 10 5 module BasicState where import Control.Monad.State.Strict import Debug.Trace type St a = State a a -- caller is not aware that main uses state -- mai is a pure function main :: Int -> Int -> Int main start0 repeat0 = evalState (repeatN repeat0) start0 -- state-passing computation repeatN :: Int -> St Int repeatN n0 -- repeat n times | n0 < 1 = get -- current state | otherwise = do withState pureStateModifier get -- update state repeatN $ n0 - 1 -- recurse -- state unaware modifier function pureStateModifier :: Int -> Int pureStateModifier = (+ 1) From rein.henrichs at gmail.com Sun Dec 13 21:03:02 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sun, 13 Dec 2015 21:03:02 +0000 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: I don't think that code snippets presented without motivation, explanation, or commentary are an effective way to teach. On Sun, Dec 13, 2015 at 9:14 AM Imants Cekusins wrote: > This snippet increments integer n times using state monad. > > How to call: > main 10 5 > > > > > module BasicState where > > import Control.Monad.State.Strict > import Debug.Trace > > type St a = State a a > > > -- caller is not aware that main uses state > -- mai is a pure function > main :: Int -> Int -> Int > main start0 repeat0 = > evalState (repeatN repeat0) start0 > > > -- state-passing computation > repeatN :: Int -> St Int > repeatN n0 -- repeat n times > | n0 < 1 = get -- current state > | otherwise = do > withState pureStateModifier get -- update state > repeatN $ n0 - 1 -- recurse > > > -- state unaware modifier function > pureStateModifier :: Int -> Int > pureStateModifier = (+ 1) > _______________________________________________ > 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 imantc at gmail.com Sun Dec 13 21:10:36 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 13 Dec 2015 22:10:36 +0100 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: > I don't think that code snippets presented without motivation, explanation, or commentary are an effective way to teach. I agree, they are not. However it took me a better part of today to write this snippet. If I saw it as it is, I could proceed with my coding task without delay. I posted it just in case someone faces a similar problem and could benefit from it. This is to complement other available materials, not to replace them. -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewjwilliams101 at gmail.com Sun Dec 13 21:36:45 2015 From: matthewjwilliams101 at gmail.com (MJ Williams) Date: Sun, 13 Dec 2015 21:36:45 +0000 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: Perhaps you would be so kind as to provide the `motivation', `explanation' and maybe some `commentary' for good measure. *smile* On 13/12/2015, Imants Cekusins wrote: >> I don't think that code snippets presented without motivation, > explanation, or commentary are an effective way to teach. > > I agree, they are not. > > However it took me a better part of today to write this snippet. > > If I saw it as it is, I could proceed with my coding task without delay. > > I posted it just in case someone faces a similar problem and could benefit > from it. > > This is to complement other available materials, not to replace them. > From imantc at gmail.com Sun Dec 13 21:54:36 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 13 Dec 2015 22:54:36 +0100 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: > Perhaps you would be so kind as to provide the `motivation', `explanation' and maybe some `commentary' for good measure. Well anyone could ask specific questions, and anyone could attempt to answer, couldn't they? Let's try. -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Sun Dec 13 21:58:26 2015 From: magnus at therning.org (Magnus Therning) Date: Sun, 13 Dec 2015 22:58:26 +0100 Subject: [Haskell-beginners] Haskell code optimisation In-Reply-To: References: Message-ID: <877fkinh8d.fsf@therning.org> Sumit Sahrawat, Maths & Computing, IIT (BHU) writes: > Graham Hutton's paper "A tutorial on the expressiveness and universality of > folds", provides a good introduction to folds, and implements the Ackerman > function as an example. > Folds were the first stumbling point for me when learning Haskell, and this > paper helped me a lot. To save others from a search: http://www.cs.nott.ac.uk/~pszgmh/fold.pdf /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus Failure is not an option. It comes bundled with the software. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 800 bytes Desc: not available URL: From hjgtuyl at chello.nl Sun Dec 13 23:51:11 2015 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Mon, 14 Dec 2015 00:51:11 +0100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: <566B70D0.8070603@ucdavis.edu> References: <566B70D0.8070603@ucdavis.edu> Message-ID: On Sat, 12 Dec 2015 01:56:48 +0100, Dimitri DeFigueiredo wrote: : > Couldn't match expected type ?r? with actual type ?COParseResult? > ?r? is a rigid type variable bound by > the type signature for > getParseResult :: ParseResult r => String -> IO r > ... > > I have a PhD in computer science, but never really liked programming > languages back then and somehow I never learned what a "rigid type > variable" is. See [Haskell-cafe] What is a rigid type variable? https://mail.haskell.org/pipermail/haskell-cafe/2008-June/044622.html : > But would anyone care to explain to a > novice in a couple paragraphs why foldl (+) 0 [1..10^9] may take 10 Gigs > of RAM to calculate? The foldl builds up a very long expression and evaluates it after the last element of the list is reached (the evaluation is non-strict, or lazy). If you use foldl' (from Data.List) instead, the calculation is done per element (the evaluation is strict). For more details, see Foldr Foldl Foldl' https://wiki.haskell.org/Foldr_Foldl_Foldl' Lazy vs. non-strict https://wiki.haskell.org/Lazy_vs._non-strict Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From imantc at gmail.com Mon Dec 14 00:02:24 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 14 Dec 2015 01:02:24 +0100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <566B70D0.8070603@ucdavis.edu> Message-ID: > The foldl builds up a very long expression and evaluates it after the last element of the list is reached (the evaluation is non-strict, or lazy). If you use foldl' (from Data.List) instead, the calculation is done per element (the evaluation is strict). Is it possible to write a wrapping function (if it does not already exist) which would analyze inputs and apply appropriate fold (foldl, foldl', foldr, foldr') or safeguard (return Left warning) against following the 10Gb ram route - if this can be avoided? -------------- next part -------------- An HTML attachment was scrubbed... URL: From defigueiredo at ucdavis.edu Mon Dec 14 02:03:43 2015 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Mon, 14 Dec 2015 00:03:43 -0200 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <566B70D0.8070603@ucdavis.edu> Message-ID: <566E237F.4080508@ucdavis.edu> Oops! Sorry, I think I wasn't clear. I know the answers to all the questions I asked. They were rhetorical questions. I just wanted to make a point that learning haskell is *much* harder than learning most other programming languages and the (multitude of) learning aids that are available are not yet cohesive enough to present a clear path ahead for the average programmer. I also think this is the main reason haskell will NOT be more widely used any time soon, despite its many other advantages. I think newcomers to the language should know this before they start to evaluate their reasons and seek help from others (as in this list) to guide them in the process. Thank you very much for the pointers in any case, they look very good. Dimitri On 12/13/15 9:51 PM, Henk-Jan van Tuyl wrote: > On Sat, 12 Dec 2015 01:56:48 +0100, Dimitri DeFigueiredo > wrote: > > : >> Couldn't match expected type ?r? with actual type ?COParseResult? >> ?r? is a rigid type variable bound by >> the type signature for >> getParseResult :: ParseResult r => String -> IO r >> ... >> >> I have a PhD in computer science, but never really liked programming >> languages back then and somehow I never learned what a "rigid type >> variable" is. > > See > [Haskell-cafe] What is a rigid type variable? > https://mail.haskell.org/pipermail/haskell-cafe/2008-June/044622.html > > : >> But would anyone care to explain to a >> novice in a couple paragraphs why foldl (+) 0 [1..10^9] may take 10 Gigs >> of RAM to calculate? > > The foldl builds up a very long expression and evaluates it after the > last element of the list is reached (the evaluation is non-strict, or > lazy). If you use foldl' (from Data.List) instead, the calculation is > done per element (the evaluation is strict). > > For more details, see > Foldr Foldl Foldl' > https://wiki.haskell.org/Foldr_Foldl_Foldl' > > Lazy vs. non-strict > https://wiki.haskell.org/Lazy_vs._non-strict > > Regards, > Henk-Jan van Tuyl > > From strombrg at gmail.com Mon Dec 14 02:28:07 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Sun, 13 Dec 2015 18:28:07 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <566B70D0.8070603@ucdavis.edu> Message-ID: On Sun, Dec 13, 2015 at 4:02 PM, Imants Cekusins wrote: > > The foldl builds up a very long expression and evaluates it after the > last element of the list is reached (the evaluation is non-strict, or > lazy). If you use foldl' (from Data.List) instead, the calculation is done > per element (the evaluation is strict). > > Is it possible to write a wrapping function (if it does not already exist) > which would analyze inputs and apply appropriate fold (foldl, foldl', > foldr, foldr') or safeguard (return Left warning) against following the > 10Gb ram route - if this can be avoided? > I know next to nothing about Haskell, but I suspect this would require knowing whether a list is finite or infinite, which may be equivalent to "the halting problem" - IOW, not possible in general in a finite amount of time. -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From math.simplex at gmail.com Mon Dec 14 04:57:27 2015 From: math.simplex at gmail.com (Graham Gill) Date: Sun, 13 Dec 2015 23:57:27 -0500 Subject: [Haskell-beginners] Extend instance for List Message-ID: <566E4C37.1030805@gmail.com> The NICTA course includes exercises on the type class Extend, in Course/Extend.hs. Extend is a superclass of Comonad. Here's the class definition: > -- | All instances of the `Extend` type-class must satisfy one law. > This law > -- is not checked by the compiler. This law is given as: > -- > -- * The law of associativity > -- `?f g. (f <<=) . (g <<=) ? (<<=) (f . (g <<=))` > class Functor f => Extend f where > -- Pronounced, extend. > (<<=) :: > (f a -> b) > -> f a > -> f b > > infixr 1 <<= Could someone please motivate the Extend instance for List? (Its implementation is left as an exercise. In the course, type List a is isomorphic to [a].) Some of the tests (<<=) is expected to pass are shown, and make clear what ought to happen. > -- | Implement the @Extend@ instance for @List at . > -- > -- >>> length <<= ('a' :. 'b' :. 'c' :. Nil) > -- [3,2,1] > -- > -- >>> id <<= (1 :. 2 :. 3 :. 4 :. Nil) > -- [[1,2,3,4],[2,3,4],[3,4],[4]] > -- > -- >>> reverse <<= ((1 :. 2 :. 3 :. Nil) :. (4 :. 5 :. 6 :. Nil) :. Nil) > -- [[[4,5,6],[1,2,3]],[[4,5,6]]] The following (wrong, according to the tests) Extend instance for List nevertheless obeys the types and obeys the Extend law of associativity. > instance Extend List where > (<<=) :: > (List a -> b) > -> List a > -> List b > (<<=) f = (:. Nil) . f (:. Nil) is analogous to (: []), create a singleton list. I can't find a good reference on the Extend type class to convince me why the correct Extend instance for List in the course is the desirable one. (I'm not saying my version is desirable, in fact it seems fairly useless, but it works.) Graham -------------- next part -------------- An HTML attachment was scrubbed... URL: From gesh at gesh.uni.cx Mon Dec 14 10:53:24 2015 From: gesh at gesh.uni.cx (Gesh) Date: Mon, 14 Dec 2015 12:53:24 +0200 Subject: [Haskell-beginners] Extend instance for List In-Reply-To: <566E4C37.1030805@gmail.com> References: <566E4C37.1030805@gmail.com> Message-ID: <99BD0A81-6FBC-4F61-BE68-450697CC8A4F@gesh.uni.cx> On December 14, 2015 6:57:27 AM GMT+02:00, Graham Gill wrote: >The NICTA course includes exercises >on >the type class Extend, in Course/Extend.hs. Extend is a superclass of >Comonad. Here's the class definition: >> -- | All instances of the `Extend` type-class must satisfy one law. >> This law >> -- is not checked by the compiler. This law is given as: >> -- >> -- * The law of associativity >> -- `?f g. (f <<=) . (g <<=) ? (<<=) (f . (g <<=))` >> class Functor f => Extend f where >> -- Pronounced, extend. >> (<<=) :: >> (f a -> b) >> -> f a >> -> f b >> >> infixr 1 <<= > >Could someone please motivate the Extend instance for List? (Its >implementation is left as an exercise. In the course, type List a is >isomorphic to [a].) Some of the tests (<<=) is expected to pass are >shown, and make clear what ought to happen. >> -- | Implement the @Extend@ instance for @List at . >> -- >> -- >>> length <<= ('a' :. 'b' :. 'c' :. Nil) >> -- [3,2,1] >> -- >> -- >>> id <<= (1 :. 2 :. 3 :. 4 :. Nil) >> -- [[1,2,3,4],[2,3,4],[3,4],[4]] >> -- >> -- >>> reverse <<= ((1 :. 2 :. 3 :. Nil) :. (4 :. 5 :. 6 :. Nil) :. >Nil) >> -- [[[4,5,6],[1,2,3]],[[4,5,6]]] > >The following (wrong, according to the tests) Extend instance for List >nevertheless obeys the types and obeys the Extend law of associativity. >> instance Extend List where >> (<<=) :: >> (List a -> b) >> -> List a >> -> List b >> (<<=) f = (:. Nil) . f >(:. Nil) is analogous to (: []), create a singleton list. > >I can't find a good reference on the Extend type class to convince me >why the correct Extend instance for List in the course is the desirable > >one. (I'm not saying my version is desirable, in fact it seems fairly >useless, but it works.) > >Graham > > > >------------------------------------------------------------------------ > >_______________________________________________ >Beginners mailing list >Beginners at haskell.org >http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners Indeed, your implementation is a valid Extend instance. However, it cannot be extended into a valid Comonad, whereas the supplied instance can. Can you see why? Hint: In order to be a Comonad, an Extend instance must also supply a function extract:: f a -> a which must be an identity for extend. Is this possible for your instance? The intuition behind Extend is that given a computation that takes into account the context of the values in your container, it applies that computation everywhere, passing it the appropriate context. Thus, elements of List may be considered as having the remainder of the list as their context, and that is indeed what is passed to the computation, as evidence by extend id. Indeed, this function is so essential to the essence of a Comonad that it is given its own name - duplicate - and forms the building block for an equivalent set of laws for Comonad, namely: - duplicate . duplicate = fmap duplicate . duplicate - extract . duplicate = id = fmap extract . duplicate (If you've heard of join in the context of Monad, this is precisely the dual set of laws it satisfies) Indeed, it may be easier to prove your Extend instance doesn't extend to a Comonad instance by using this formulation of the laws. HTH, Gesh From 50295 at web.de Mon Dec 14 12:36:49 2015 From: 50295 at web.de (Olumide) Date: Mon, 14 Dec 2015 12:36:49 +0000 Subject: [Haskell-beginners] Understanding Haskell Map.lookup Example in LYH Message-ID: <566EB7E1.7050805@web.de> Hello Haskellers! I'd appreciate help understanding the origin of the extra 'map' in 'Map.lookup lockerNumber map', from the following example taken from chapter 8 of "Learn You a Haskell for Great Good" http://learnyouahaskell.com/making-our-own-types-and-typeclasses#type-synonyms lockerLookup :: Int -> LockerMap -> Either String Code lockerLookup lockerNumber map = case Map.lookup lockerNumber map of Nothing -> Left $ "Locker number " ++ show lockerNumber ++ " doesn't exist!" Just (state, code) -> if state /= Taken then Right code else Left $ "Locker " ++ show lockerNumber ++ " is already taken!" Regards, - Olumide From fa-ml at ariis.it Mon Dec 14 12:42:34 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 14 Dec 2015 13:42:34 +0100 Subject: [Haskell-beginners] Understanding Haskell Map.lookup Example in LYH In-Reply-To: <566EB7E1.7050805@web.de> References: <566EB7E1.7050805@web.de> Message-ID: <20151214124234.GA19727@casa.casa> On Mon, Dec 14, 2015 at 12:36:49PM +0000, Olumide wrote: > Hello Haskellers! > > I'd appreciate help understanding the origin of the extra 'map' in > 'Map.lookup lockerNumber map', from the following example taken from chapter > 8 of "Learn You a Haskell for Great Good" > http://learnyouahaskell.com/making-our-own-types-and-typeclasses#type-synonyms > > lockerLookup :: Int -> LockerMap -> Either String Code > lockerLookup lockerNumber map = > case Map.lookup lockerNumber map of > Nothing -> [...] Hello Olumide, `map` is just a parameter name. `Map.lookup` type is ?> :t Data.Map.lookup Data.Map.lookup :: Ord k => k -> Map k a -> Maybe a (so a key and a container, returning `Maybe a`). The name `map` for the second parameter is unfortunate because it is the same as the much loved `map` function; in this case map-the-function get shadowed by the-parameter-named-map. I hope this helps, if not fire again! From johnlusk4 at gmail.com Mon Dec 14 17:19:46 2015 From: johnlusk4 at gmail.com (John Lusk) Date: Mon, 14 Dec 2015 12:19:46 -0500 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Dude... it's the Haskell *Beginners* List. STM, I guess, is Shared Transactional Memory. But OTP? Wazzat? On Fri, Dec 11, 2015 at 4:36 PM, Christopher Allen wrote: > Having the option of communicating by sharing memory, message-passing > style (copying), or copy-on-write semantics in Haskell programs is why I've > found Haskell to be a real pleasure for performance (latency, mostly) > sensitive services I frequently work on. I get a superset of options in > Haskell for which I don't have any one choice that can really match it in > concurrency problems or single-machine parallelism. There's some work to be > done to catch up to OTP, but the community is inching its way a few > directions (Cloud Haskell/distributed haskell, courier, streaming lib + > networking, etc.) > > Generally I prefer to build out services in a conventional style (breaking > out capacities like message backends or persistence into separate > machines), but the workers/app servers are all in Haskell. That is, I don't > try to replicate the style of cluster you'd see with Erlang services in > Haskell, but I know people that have done so and were happy with the > result. Being able to have composable concurrency via STM without > compromising correctness is _no small thing_ and the cheap threads along > with other features of Haskell have served to make it so that concurrency > and parallelization of Haskell programs can be a much more modular process > than I've experienced in many other programming languages. It makes it so > that I can write programs totally oblivious to concurrency or parallelism > and then layer different strategies of parallelization or synchronization > after the fact, changing them out at runtime if I so desire! This is only > possible for me in Haskell because of the non-strict semantics and > incredible kit we have at our disposal thanks to the efforts of Simon > Marlow and others. Much of this is ably covered in Marlow's book at: > http://chimera.labs.oreilly.com/books/1230000000929 > > Side bar: although using "pure" with respect to effects is the common > usage now, I'd urge you to consider finding a different wording since the > original (and IMHO more meaningful) denotation of pure functional > programming was about semantics and not the presence or absence of effects. > The meaning was that you had a programming language whose semantics were > lambda-calculus-and-nothing-more. This can be contrasted with ML where the > lambda calculus is augmented with an imperative language that isn't > functional or a lambda calculus. Part of the problem with making purity > about effects rather than semantics is the terrible imprecision confuses > new people. They'll often misunderstand it as, "Haskell programs can't > perform effects" or they'll think it means stuff in "IO" isn't pure - which > is false. We benefit from having a pure functionalal programming language > _especially_ in programs that emit effects. Gabriel Gonzalez has a nice > article demonstrating some of this: > http://www.haskellforall.com/2015/03/algebraic-side-effects.html > > When I want to talk about effects, I say "effect". When I want to say > something that doesn't emit effects, I say "effect-free" and when it does, > "effectful". Sometimes I'll say "in IO" for the latter as well, where "in > IO" can be any type that has IO in the outermost position of the final > return type. > > But, in the end, I'm not really here to convince anybody to use Haskell. > I'm working on http://haskellbook.com/ with my coauthor Julie because I > thought it was unreasonably difficult and time-consuming to learn a > language that is quite pleasant and productive to use in my day to day > work. If Haskell picks up in popularity, cool - more libraries! If not, > then it remains an uncommon and not well-understood competitive advantage > in my work. I'm not sure I mind either outcome as long as the community > doesn't contract and it seems to be doing the opposite of that lately. > > I use Haskell because I'm lazy and impatient. I do not tolerate tedious, > preventable work well. Haskell lets me break down my problems into > digestible units, it forces the APIs I consume to declare what chicanery > they're up to, it gives me the nicest kit for my work I've ever had at my > disposal. It's not perfect - it's best if you're comfortable with a unix-y > toolkit, but there's Haskellers on Windows keeping the lights on too. > > Best of luck to Abhishek whatever they decide to do from here. I won't > pretend Haskell is "easy" - you have to learn more before you can write the > typical software project, but it's an upfront cliff sorta thing that > converts into a long-term advantage if you're willing to do the work. This > is more the case than what I found with Clojure, Erlang, Java, C++, Go, > etc. They all have a gentler upfront productivity cliff, but don't pay off > nearly as well long-term in my experience. YMMV. > > On Fri, Dec 11, 2015 at 3:13 PM, Darren Grant wrote: > >> Regarding concurrency+immutability with respect to both reliability and >> performance: >> >> One way to think about synchronizing concurrent programs is by sharing >> memory. If the content of that memory changes, then there is a risk of race >> conditions arising in the affected programs. (A common source of vexing >> bugs, and complications for compilers.) But if the contents are somehow >> guaranteed not to change (ie. a specific definition of immutability), then >> no race conditions are possible for the lifetime of access to that memory. >> >> Although this is a greatly simplified illustrative explanation, it is >> generally at the heart of arguments for immutability aiding performance. >> Unchanging regions of memory tend to permit simpler sorts of models since >> limitations are lifted on synchronization. This in turn allows both more >> freedom to pursue many otherwise tricky optimizations, such as ex. deciding >> when to duplicate based on cache geometry, trivially remembering old >> results, etc. >> >> Regarding the discourse on purely functional programs not having side >> effects: >> >> Writing pure programs without side effects is a little tricky to talk >> about, since this has some very precise technical meanings depending on >> whom you talk to. (What constitutes an effect? Where is the line between >> intentional and unintentional drawn?) >> >> Maybe think of this statement as part of the continuum of arguments about >> languages that allow us to write simpler programs that more precisely state >> the intended effects. >> >> Cheers, >> Darren >> On Dec 11, 2015 07:07, "Abhishek Kumar" wrote: >> >>> I am a beginner in haskell.I have heard a lot about haskell being great >>> for parallel programming and concurrency but couldn't understand why?Aren't >>> iterative algorithms like MapReduce more suitable to run parallely?Also how >>> immutable data structures add to speed?I'm having trouble understanding >>> very philosophy of functional programming, how do we gain by writing >>> everything as functions and pure code(without side effects)? >>> Any links or references will be a great help. >>> Thanks >>> Abhishek Kumar >>> >>> _______________________________________________ >>> 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 >> >> > > > -- > Chris Allen > Currently working on http://haskellbook.com > > _______________________________________________ > 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 imantc at gmail.com Mon Dec 14 17:24:59 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 14 Dec 2015 18:24:59 +0100 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Erlang OTP http://www.erlang.org/ https://en.m.wikipedia.org/wiki/Open_Telecom_Platform -------------- next part -------------- An HTML attachment was scrubbed... URL: From math.simplex at gmail.com Mon Dec 14 17:43:08 2015 From: math.simplex at gmail.com (Graham Gill) Date: Mon, 14 Dec 2015 12:43:08 -0500 Subject: [Haskell-beginners] Extend instance for List In-Reply-To: <99BD0A81-6FBC-4F61-BE68-450697CC8A4F@gesh.uni.cx> References: <566E4C37.1030805@gmail.com> <99BD0A81-6FBC-4F61-BE68-450697CC8A4F@gesh.uni.cx> Message-ID: <566EFFAC.3030006@gmail.com> Thank you Gesh. Your reply is very helpful. I guessed that the correct Extend instance for List is needed for Comonad, but didn't have any intuition about it. The way the NICTA course is structured, there's no mention of the dependence between "extend" and "copure" (equivalent to extract and duplicate I suppose) via the Comonad laws when considering Extend first by itself. I'm not knocking the NICTA course. I've found it useful. A quick paragraph or two as you've written, stuck into the source files as comments, would improve it. Regards, Graham On 12/14/2015 5:53 AM, Gesh wrote: > On December 14, 2015 6:57:27 AM GMT+02:00, Graham Gill wrote: >> The NICTA course includes exercises >> on >> the type class Extend, in Course/Extend.hs. Extend is a superclass of >> Comonad. Here's the class definition: >>> -- | All instances of the `Extend` type-class must satisfy one law. >>> This law >>> -- is not checked by the compiler. This law is given as: >>> -- >>> -- * The law of associativity >>> -- `?f g. (f <<=) . (g <<=) ? (<<=) (f . (g <<=))` >>> class Functor f => Extend f where >>> -- Pronounced, extend. >>> (<<=) :: >>> (f a -> b) >>> -> f a >>> -> f b >>> >>> infixr 1 <<= >> Could someone please motivate the Extend instance for List? (Its >> implementation is left as an exercise. In the course, type List a is >> isomorphic to [a].) Some of the tests (<<=) is expected to pass are >> shown, and make clear what ought to happen. >>> -- | Implement the @Extend@ instance for @List at . >>> -- >>> -- >>> length <<= ('a' :. 'b' :. 'c' :. Nil) >>> -- [3,2,1] >>> -- >>> -- >>> id <<= (1 :. 2 :. 3 :. 4 :. Nil) >>> -- [[1,2,3,4],[2,3,4],[3,4],[4]] >>> -- >>> -- >>> reverse <<= ((1 :. 2 :. 3 :. Nil) :. (4 :. 5 :. 6 :. Nil) :. >> Nil) >>> -- [[[4,5,6],[1,2,3]],[[4,5,6]]] >> The following (wrong, according to the tests) Extend instance for List >> nevertheless obeys the types and obeys the Extend law of associativity. >>> instance Extend List where >>> (<<=) :: >>> (List a -> b) >>> -> List a >>> -> List b >>> (<<=) f = (:. Nil) . f >> (:. Nil) is analogous to (: []), create a singleton list. >> >> I can't find a good reference on the Extend type class to convince me >> why the correct Extend instance for List in the course is the desirable >> >> one. (I'm not saying my version is desirable, in fact it seems fairly >> useless, but it works.) >> >> Graham >> >> >> >> ------------------------------------------------------------------------ >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > Indeed, your implementation is a valid Extend instance. However, it cannot be extended into a valid Comonad, whereas the supplied instance can. > > Can you see why? > Hint: In order to be a Comonad, an Extend instance must also supply a function extract:: f a -> a which must be an identity for extend. Is this possible for your instance? > > The intuition behind Extend is that given a computation that takes into account the context of the values in your container, it applies that computation everywhere, passing it the appropriate context. Thus, elements of List may be considered as having the remainder of the list as their context, and that is indeed what is passed to the computation, as evidence by extend id. > > Indeed, this function is so essential to the essence of a Comonad that it is given its own name - duplicate - and forms the building block for an equivalent set of laws for Comonad, namely: > - duplicate . duplicate = fmap duplicate . duplicate > - extract . duplicate = id = fmap extract . duplicate > (If you've heard of join in the context of Monad, this is precisely the dual set of laws it satisfies) > > Indeed, it may be easier to prove your Extend instance doesn't extend to a Comonad instance by using this formulation of the laws. > > HTH, > Gesh > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From rajasharan at gmail.com Mon Dec 14 17:49:12 2015 From: rajasharan at gmail.com (Raja) Date: Mon, 14 Dec 2015 12:49:12 -0500 Subject: [Haskell-beginners] Monad and bind operator interpretation Message-ID: The type signature of bind (>>=) is as follows: (>>=) :: m a -> (a -> m b) -> m b One interpretation of this could be as follows: bind takes two parameters (m a & f) and returns m b (the same type returned by f) So extending this interpretation - can I swap the two parameters (?) Now my new hypothetical interpretation becomes: (>>=) :: (a -> m b) -> m a -> m b If i further add parens: (>>=) (a -> m b) -> (m a -> m b) This allows me to slightly tweak my interpretation: bind takes one param f (of type a -> m b) and returns another param f (of type m a -> m b) This feels like a more intuitive way to think about Monads - am I on the right track? (not that I want to switch the params permanently - just trying to get a feel for monads) -------------- next part -------------- An HTML attachment was scrubbed... URL: From exitconsole at gmail.com Mon Dec 14 18:17:23 2015 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Mon, 14 Dec 2015 19:17:23 +0100 Subject: [Haskell-beginners] Monad and bind operator interpretation In-Reply-To: References: Message-ID: On 14/12/2015, Raja wrote: > So extending this interpretation - can I swap the two parameters (?) > > Now my new hypothetical interpretation becomes: > > (>>=) :: (a -> m b) -> m a -> m b Sure, bind' :: Monad m => (a -> m b) -> m a -> m b bind' = flip (>>=) > If i further add parens: > > (>>=) :: (a -> m b) -> (m a -> m b) Yeah, that's exactly the same thing. Types are right associative. From johnlusk4 at gmail.com Mon Dec 14 18:29:36 2015 From: johnlusk4 at gmail.com (John Lusk) Date: Mon, 14 Dec 2015 13:29:36 -0500 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: Message-ID: Thanks. On Mon, Dec 14, 2015 at 12:24 PM, Imants Cekusins wrote: > Erlang OTP > > http://www.erlang.org/ > > https://en.m.wikipedia.org/wiki/Open_Telecom_Platform > > _______________________________________________ > 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 joel.s.williamson at gmail.com Mon Dec 14 18:41:09 2015 From: joel.s.williamson at gmail.com (Joel Williamson) Date: Mon, 14 Dec 2015 18:41:09 +0000 Subject: [Haskell-beginners] Monad and bind operator interpretation In-Reply-To: References: Message-ID: This function is actually in the Prelude as (=<<). On Mon, 14 Dec 2015, 13:17 D?niel Arat? wrote: > On 14/12/2015, Raja wrote: > > So extending this interpretation - can I swap the two parameters (?) > > > > Now my new hypothetical interpretation becomes: > > > > (>>=) :: (a -> m b) -> m a -> m b > > Sure, > bind' :: Monad m => (a -> m b) -> m a -> m b > bind' = flip (>>=) > > > If i further add parens: > > > > (>>=) :: (a -> m b) -> (m a -> m b) > > Yeah, that's exactly the same thing. Types are right associative. > _______________________________________________ > 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 tanuki at gmail.com Mon Dec 14 22:04:57 2015 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Mon, 14 Dec 2015 14:04:57 -0800 Subject: [Haskell-beginners] Monad and bind operator interpretation In-Reply-To: References: Message-ID: Yeah, after my first couple of significant Haskell projects I came to the conclusion that having (>>=) instead of (=<<) as the "canonical bind" is a wart. (>>=) makes for clean desugaring of do notation, but obscures that (a -> m b) -> (m a -> m b) intuition, which I think is more important pedagogically and also tends to be cleaner in non-do monadic code. To a beginner, flip is an easy mechanical concept, but analyzing the resultant type for new insights is not a habit yet. The one whose purpose is purely mechanical should be "the flipped one." On Dec 14, 2015 10:41 AM, "Joel Williamson" wrote: > This function is actually in the Prelude as (=<<). > > On Mon, 14 Dec 2015, 13:17 D?niel Arat? wrote: > >> On 14/12/2015, Raja wrote: >> > So extending this interpretation - can I swap the two parameters (?) >> > >> > Now my new hypothetical interpretation becomes: >> > >> > (>>=) :: (a -> m b) -> m a -> m b >> >> Sure, >> bind' :: Monad m => (a -> m b) -> m a -> m b >> bind' = flip (>>=) >> >> > If i further add parens: >> > >> > (>>=) :: (a -> m b) -> (m a -> m b) >> >> Yeah, that's exactly the same thing. Types are right associative. >> _______________________________________________ >> 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 alexander at plaimi.net Tue Dec 15 08:55:44 2015 From: alexander at plaimi.net (Alexander Berntsen) Date: Tue, 15 Dec 2015 09:55:44 +0100 Subject: [Haskell-beginners] explaining effects In-Reply-To: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: <566FD590.70607@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 On 12/12/15 14:38, Daniel Bergey wrote: > Why do you prefer "effect" to "side effect"? FWIW, I say "effect" rather than "side effect" when talking about Haskell, because in Haskell effects happen when you want them, not as an unforeseen side-effect as a result of the complexity inherent to the source code. It is often said that having an effect is "difficult" in Haskell. But really, it's just that if you are launching missiles in Haskell, *you actually mean to*. It didn't happen because you wanted to increment i and then "oops, stuff happened". - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWb9WQAAoJENQqWdRUGk8BinMQAIzlf+zL00pjSfu/nkx8W59D IeGbGCWV8zG74963SmCJP70UzamysWs20my+XL7B8UnzbPY/1mKTDK56P/rI+Vbn +YUzWqNWDEuu8g37ATNrOyy99TyX+murkO10KnrYl9aVsOu4IK5in5dR95AKqouC f+NOD6LC29OWX+IfSzGajtmAlRra0yfn7C2x99TktL0+f+GpNHgdaY73SrYeqTaV rV8YF05pnAkHBI7wlXG3b5lwt9Zwhuiy7JLmaSZU1PrZM05/MQBXdiI7ShJafLvm GT8H6RgnnVmudRZYsVKK38mBU+GGiQ2J6VqUXBkCXbrxIB1Z0unNb6puw+nb6xNm 1jDM8DTzJZDD2H+sruZdI/R4wAcviVG79j/Kr6q5uraLkpylXo8w08w4MWKDeAL7 AX8Nv5OrdS9D9Ol9O6I1Tk3UGODQtkso5lo/M1LBT3KX6zCj7b1IZUw51sMLFmfY gOl4oFXG0Sn4+iVWNFE69li8Bx05EI7H/YK3B4hJyftsKsV3upMHIoruN1fHUVO4 kBhX5A676X1EIIWp2WDvix0Tl7F8KM05abD280+bGdDH3GRqKSaew5fpJmhZ7Qc3 Nxad8vMZoNPXaODf/jGIpZ1v4wcbKwwicjD4xZJeB8MQpCcAWkxTm3izoY2ZpzNm 6aO62BltRu2CNYcxYEhW =crfn -----END PGP SIGNATURE----- From objitsu at gmail.com Tue Dec 15 09:15:19 2015 From: objitsu at gmail.com (emacstheviking) Date: Tue, 15 Dec 2015 09:15:19 +0000 Subject: [Haskell-beginners] explaining effects In-Reply-To: <566FD590.70607@plaimi.net> References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> Message-ID: good answer! Having worked on a lot of embedded microprocessor systems over the years... that's exactly the kind of thing you don't want and sometimes all too easy to do by mistake when writing C or assembler! Good answer! :) On 15 December 2015 at 08:55, Alexander Berntsen wrote: > -----BEGIN PGP SIGNED MESSAGE----- > Hash: SHA512 > > On 12/12/15 14:38, Daniel Bergey wrote: > > Why do you prefer "effect" to "side effect"? > FWIW, I say "effect" rather than "side effect" when talking about > Haskell, because in Haskell effects happen when you want them, not as > an unforeseen side-effect as a result of the complexity inherent to > the source code. > > It is often said that having an effect is "difficult" in Haskell. But > really, it's just that if you are launching missiles in Haskell, *you > actually mean to*. It didn't happen because you wanted to increment i > and then "oops, stuff happened". > > - -- > Alexander > alexander at plaimi.net > https://secure.plaimi.net/~alexander > -----BEGIN PGP SIGNATURE----- > Version: GnuPG v2 > > iQIcBAEBCgAGBQJWb9WQAAoJENQqWdRUGk8BinMQAIzlf+zL00pjSfu/nkx8W59D > IeGbGCWV8zG74963SmCJP70UzamysWs20my+XL7B8UnzbPY/1mKTDK56P/rI+Vbn > +YUzWqNWDEuu8g37ATNrOyy99TyX+murkO10KnrYl9aVsOu4IK5in5dR95AKqouC > f+NOD6LC29OWX+IfSzGajtmAlRra0yfn7C2x99TktL0+f+GpNHgdaY73SrYeqTaV > rV8YF05pnAkHBI7wlXG3b5lwt9Zwhuiy7JLmaSZU1PrZM05/MQBXdiI7ShJafLvm > GT8H6RgnnVmudRZYsVKK38mBU+GGiQ2J6VqUXBkCXbrxIB1Z0unNb6puw+nb6xNm > 1jDM8DTzJZDD2H+sruZdI/R4wAcviVG79j/Kr6q5uraLkpylXo8w08w4MWKDeAL7 > AX8Nv5OrdS9D9Ol9O6I1Tk3UGODQtkso5lo/M1LBT3KX6zCj7b1IZUw51sMLFmfY > gOl4oFXG0Sn4+iVWNFE69li8Bx05EI7H/YK3B4hJyftsKsV3upMHIoruN1fHUVO4 > kBhX5A676X1EIIWp2WDvix0Tl7F8KM05abD280+bGdDH3GRqKSaew5fpJmhZ7Qc3 > Nxad8vMZoNPXaODf/jGIpZ1v4wcbKwwicjD4xZJeB8MQpCcAWkxTm3izoY2ZpzNm > 6aO62BltRu2CNYcxYEhW > =crfn > -----END PGP SIGNATURE----- > _______________________________________________ > 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 Tue Dec 15 09:44:14 2015 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 15 Dec 2015 09:44:14 +0000 (UTC) Subject: [Haskell-beginners] explaining effects In-Reply-To: References: Message-ID: <93304146.2131330.1450172654161.JavaMail.yahoo@mail.yahoo.com> A good and witty answer :) On Tuesday, 15 December 2015, 9:16, emacstheviking wrote: good answer! ? Having worked on a lot of embedded microprocessor systems over the years... that's exactly the kind of thing you don't want and sometimes all too easy to do by mistake when writing C or assembler! Good answer! :) On 15 December 2015 at 08:55, Alexander Berntsen wrote: -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 On 12/12/15 14:38, Daniel Bergey wrote: > Why do you prefer "effect" to "side effect"? FWIW, I say "effect" rather than "side effect" when talking about Haskell, because in Haskell effects happen when you want them, not as an unforeseen side-effect as a result of the complexity inherent to the source code. It is often said that having an effect is "difficult" in Haskell. But really, it's just that if you are launching missiles in Haskell, *you actually mean to*. It didn't happen because you wanted to increment i and then "oops, stuff happened". - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWb9WQAAoJENQqWdRUGk8BinMQAIzlf+zL00pjSfu/nkx8W59D IeGbGCWV8zG74963SmCJP70UzamysWs20my+XL7B8UnzbPY/1mKTDK56P/rI+Vbn +YUzWqNWDEuu8g37ATNrOyy99TyX+murkO10KnrYl9aVsOu4IK5in5dR95AKqouC f+NOD6LC29OWX+IfSzGajtmAlRra0yfn7C2x99TktL0+f+GpNHgdaY73SrYeqTaV rV8YF05pnAkHBI7wlXG3b5lwt9Zwhuiy7JLmaSZU1PrZM05/MQBXdiI7ShJafLvm GT8H6RgnnVmudRZYsVKK38mBU+GGiQ2J6VqUXBkCXbrxIB1Z0unNb6puw+nb6xNm 1jDM8DTzJZDD2H+sruZdI/R4wAcviVG79j/Kr6q5uraLkpylXo8w08w4MWKDeAL7 AX8Nv5OrdS9D9Ol9O6I1Tk3UGODQtkso5lo/M1LBT3KX6zCj7b1IZUw51sMLFmfY gOl4oFXG0Sn4+iVWNFE69li8Bx05EI7H/YK3B4hJyftsKsV3upMHIoruN1fHUVO4 kBhX5A676X1EIIWp2WDvix0Tl7F8KM05abD280+bGdDH3GRqKSaew5fpJmhZ7Qc3 Nxad8vMZoNPXaODf/jGIpZ1v4wcbKwwicjD4xZJeB8MQpCcAWkxTm3izoY2ZpzNm 6aO62BltRu2CNYcxYEhW =crfn -----END PGP SIGNATURE----- _______________________________________________ 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 Dec 15 10:36:58 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 15 Dec 2015 17:36:58 +0700 Subject: [Haskell-beginners] Extend instance for List In-Reply-To: <566EFFAC.3030006@gmail.com> References: <566E4C37.1030805@gmail.com> <99BD0A81-6FBC-4F61-BE68-450697CC8A4F@gesh.uni.cx> <566EFFAC.3030006@gmail.com> Message-ID: On Tue, Dec 15, 2015 at 12:43 AM, Graham Gill wrote: I guessed that the correct Extend instance for List is needed for Comonad, > but didn't have any intuition about it. > List is not comonadic. In this case, the function copure must be of type [a] -> a, which must necessarily be partial. (Non-empty lists, on the other hand, are comonadic.) Graham's "Extend" -- I'll explain the scare quotes in a minute -- instance for List obeys the associative law. So it's a valid instance but a bit boring. The exercise asks for an interesting instance. The way the NICTA course is structured, there's no mention of the > dependence between "extend" and "copure" (equivalent to extract and > duplicate I suppose) via the Comonad laws when considering Extend first by > itself. > It's a bit terse, but you can find "class Extend f => Comonad f" in Comonad.hs. After all, we're only looking at the exercises. The live lecture version probably does talk about the dependence. > I'm not knocking the NICTA course. I've found it useful. A quick paragraph > or two as you've written, stuck into the source files as comments, would > improve it. > Most folks are neutral about the course. If parts of it work for you, great. If not, no worries. The whole comonadic business is a bit obscure and some of the strongest haskell programmers don't bat an eyelid over not knowing it. p.s. "Extend" doesn't agree with the CT literature. See the paragraph that starts "The dual problem is the problem of lifting a morphism" here: http://ncatlab.org/nlab/show/extension But calling it a "lift" or "lifting" will only add to the confusion since monad transformers got first dibs on the terminology. Which is why you sometimes see "coextend" or (for the flipped version) "cobind". -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From doug at cs.dartmouth.edu Tue Dec 15 11:32:26 2015 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Tue, 15 Dec 2015 06:32:26 -0500 Subject: [Haskell-beginners] Doubts about functional programming paradigm Message-ID: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Though this post was prompted by beginners at haskell.org, it seemed pertinent enough for cross-posting to haskell-prime. > I just wanted to make a point that learning haskell is *much* > harder than learning most other programming languages I would not put it that way. One gets so much farther in capability almost instantly with a functional language. I know. At the dawn of functional programming, John McCarthy could teach in one hour everything from cons up to symbol manipulation that would have been a month's project in Fortran. (My account of that hour is at http://www.paulgraham.com/mcilroy.html.) What's hard about Haskell is that its landscape extends into terrains not imagined elsewhere. As long as you stay in the flat Floridian landscape of Fortran et al, you don't need to explore the Himalayas of Haskell. But of course the very exhilaration and inspiration of the high peaks draws one into the "*much* harder" training necessary to surmount them. > the learning aids that are available are not yet cohesive > enough to present a clear path ahead for the average programmer. I agree with this. Alas, there does not exist a definition of the Haskell one reads about on the haskell-cafe mailing list. I treasure my hardcover Haskell 98 report--so rare you can't even find it in the used-book marketplace. Haskell 2010 was obsolete as soon as it was promulgated. Contemporary Haskell as practiced by cognoscenti flaps in a gale of language pragmas. There is no authoritative source about these pragmas. They are listed and described in the GHC User Guide, but that source all too often defines solely by example, not even bolstered by a formal syntax specification. I earnestly hope the newly revived Haskell-prime committee can rectify this state of affairs, and that GHC will provide a compliant implementation. Doug McIlroy From k-bx at k-bx.com Tue Dec 15 14:52:53 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Tue, 15 Dec 2015 16:52:53 +0200 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: Is your intent is to call main function? How do you compile this module, is it part of a bigger project, or just a single-file program? If single-file -- rename main to something else, then create a main function which has a type "main :: IO ()", and put something like: main :: IO () main = print (mainRoutine 10 5) It'll call mainRoutine with 10 and 5 args and print its result. You can then run it with "runhaskell MyProg.hs" On Sun, Dec 13, 2015 at 7:14 PM, Imants Cekusins wrote: > This snippet increments integer n times using state monad. > > How to call: > main 10 5 > > > > > module BasicState where > > import Control.Monad.State.Strict > import Debug.Trace > > type St a = State a a > > > -- caller is not aware that main uses state > -- mai is a pure function > main :: Int -> Int -> Int > main start0 repeat0 = > evalState (repeatN repeat0) start0 > > > -- state-passing computation > repeatN :: Int -> St Int > repeatN n0 -- repeat n times > | n0 < 1 = get -- current state > | otherwise = do > withState pureStateModifier get -- update state > repeatN $ n0 - 1 -- recurse > > > -- state unaware modifier function > pureStateModifier :: Int -> Int > pureStateModifier = (+ 1) > _______________________________________________ > 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 imantc at gmail.com Tue Dec 15 15:05:29 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 15 Dec 2015 16:05:29 +0100 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: > Is your intent is to call main function? ... Hello Kostiantyn, my intent was to share a working snippet with those who may run into a similar problem. I can call it and run it ok. I understand that you could run it without problems too if you wanted. If not, kindly let me know. From k-bx at k-bx.com Tue Dec 15 15:24:58 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Tue, 15 Dec 2015 17:24:58 +0200 Subject: [Haskell-beginners] basic State Monad In-Reply-To: References: Message-ID: I see. Sorry, for some reason it wasn't clear for me :) On Tue, Dec 15, 2015 at 5:05 PM, Imants Cekusins wrote: > > Is your intent is to call main function? ... > > Hello Kostiantyn, > > my intent was to share a working snippet with those who may run into a > similar problem. > > I can call it and run it ok. I understand that you could run it > without problems too if you wanted. If not, kindly let me know. > _______________________________________________ > 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 imantc at gmail.com Tue Dec 15 16:38:30 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 15 Dec 2015 17:38:30 +0100 Subject: [Haskell-beginners] IO a, IO b Message-ID: Hello all, This looks like another potential 1+ day problem for me. Could you please help? Problem: a few (... -> IO a) functions are called as part of the same "do" block of container function these functions may return various IO a: "a" can be of different types I need the return values to proceed i.e. would call val <- (... -> IO a) container function returns IO b specifically, let's consider 2 functions called inside do block: ... -> IO Bool ... -> IO (Either String a) container function returns IO (Either String a) Questions: 1) what is a beginner-friendly way of doing this? 2) how would you do this? links, ideas or snippets will all be appreciated. From driemer.riemer at gmail.com Tue Dec 15 17:00:06 2015 From: driemer.riemer at gmail.com (derek riemer) Date: Tue, 15 Dec 2015 10:00:06 -0700 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: <8d5e544f-2ee7-473d-a2bf-5fea3e73fa62@email.android.com> References: <8d5e544f-2ee7-473d-a2bf-5fea3e73fa62@email.android.com> Message-ID: <56704716.7000101@gmail.com> Hey guys, This conversation is really interesting. I am not a haskell expert (I haven't progressed into monads in haskell yet, and have only briefly studied the state monad in scala. Studying fp concepts has changed the way I think about problems that are complicated. I am not quite there yet, (I still catch myself updating states when I don't need to) and wondering how the hell to break a problem into recursive little bits. I now notice that I am less tempted to do things that would have bugs in complicated data structures , prefer map to do something to a list, and folds to for loops that update a ``state'' variable, and finally, I can reason about where the weak points in my code may be. The learning I have achieved do to fp, and my principals of programming languages class that relied on fp, have made doing things with code easier because I don't try to do stupid things like overrun the end of an array with a misplaced loop counter variable. It is way too easy to learn fold, filter, map, and list comprehensions, you then have a powerful weapon to use against those ugly off by one errors. Also, I learned how people who learned programming in non-traditional languages might think to approach problems earlier this year. My stats professor was showing us things in r. She showed us a complicated set of formula that we needed to do, and then explained we were calculating something to each element of a list. She showed a function sapply(vector, function(elem)) that returns a vector. She said to think about how sapply applies that function to each vector element, and returns the transformed list. She didn't approach it as if it were this big bad function that takes a function, mainly i think because she hadn't learned programming from people who insist on the idea of c. It also really made sense to the class who mainly had little to no programming experience, where explaining a for loop in all it's glory would normally take a couple of lectures. She is a really solid programmer and really understands how to use programming to solve real world problems, so I am not saying that she didn't know enough to have not learned for loops, just that she immediately realized that the sapply function really was better for the situation. If we teach people these patterns from the get go, I think some of the horror of learning functional programming would be solved because the number of applications that a generic function can be applied in far outnumbers the number of cases a for loop or state momad is needed. I would also now argue that all data structures classes should be taught in functional programming languages. I never solidly understood trees and could confidently traverse and change them until I actually got introduced to pattern matching and folds. I was taught binary search trees, and red-black trees, and worked with tree like structures, but it was always hard for me to comprehend how to do things with them. I learned linked lists in c++ but hated them with a passion because I had to write forloops that updated a temporary variable and write while loops that did the same, but often jumped off the end of the list and then I couldn't go back. The beauty of recursion and lists is that recursion allows you to backtrack when things go wrong (as they always will for any real input in a program). The second I learned about Haskell for the first time, linked list traversing became second nature to me, even in non-functional (inferier) c++. The argument that "recursion results in overriding the stack" is kind of a flawed one since the compiler wizards have figured out ways to optimize tail recursive functions to do exactly what we humans are bad at (running recursive functions as if they were unrolled, with large inputs, and fast). Thanks, Derek On 12/11/2015 11:32 AM, Thomas Jakway wrote: > Building on that, I think coming to Haskell with a very specific goal in mind (like swap Haskell for Java in my map reduce problem) kind of misses the point. Haskell may or may not be faster/better suited to map reduce vs Java, but the real reason to use/learn Haskell is elegance and correctness. The lack of side effects and referential transparency means you're far more likely to prevent bugs. And there's a pretty substantial learning curve coming from imperative languages so if you need to speed up map reduce on a deadline you will be more productive in the imperative language of your choice (for now). > > Dont take this as discouragement, I think Haskell (and FP in general) is very well suited to that kind of problem. I'm a beginner in Haskell and it's already had a huge impact on how I think about all the code I write, not just the occasional toy Haskell project. > > On Dec 11, 2015 1:08 PM, MJ Williams wrote: >> A pure functional language enables you to reason about your code, >> something you can't easily achieve with your average C or Java. And by >> `reason' I am referring to mathematical proof. Haskell makes it very >> simple, actually. Why should you want to reason about your code? >> Think the hassle you could avoid if you knew what your code really >> meant and did when executed. >> >> The absence of side effects is part of another concept in FP, namely, >> `referential transparency'. If your function `f' maps a value `x' to >> a value `y' then `f x' will always equal `y' and no more. In other >> words, your function `f' won't change anything e.g. assign to >> variables, or other state changes as well as mapping `x' to `y', and >> that's an absolute certainty, in theory, at any rate. >> >> That's a very crude overview of at least part of what functional >> programming is about. I'm hoping it'll encourage others on this list >> with far more in-depth knowledge of the subject matter to come in and >> fill in the gaps and iron out the ambiguities. >> >> Matthew >> >> >> On 11/12/2015, Daniel Bergey wrote: >>> On 2015-12-11 at 10:07, Abhishek Kumar wrote: >>>> I am a beginner in haskell.I have heard a lot about haskell being great >>>> for >>>> parallel programming and concurrency but couldn't understand why?Aren't >>>> iterative algorithms like MapReduce more suitable to run parallely?Also >>>> how >>>> immutable data structures add to speed?I'm having trouble understanding >>>> very philosophy of functional programming, how do we gain by writing >>>> everything as functions and pure code(without side effects)? >>>> Any links or references will be a great help. >>> Functional languages make it easy to decompose problems in the way that >>> MapReduce frameworks require. A few examples (fold is another name for >>> reduce): >>> >>> sum :: [Double] -> Double >>> sum xs = foldr (+) 0 xs >>> >>> sumSquares :: [Double] -> Double >>> sumSquares xs = foldr (+) 0 (map (**2) xs) >>> >>> -- foldMap combines the map & fold steps >>> -- The Monoid instance for String specifies how to combine 2 Strings >>> -- Unlike numbers, there's only one consistent option >>> unlines :: [Text] -> Text >>> unlines xs = foldMap (`snoc` '\n') xs >>> >>> We'd need a few changes[1] to make this parallel and distribute across many >>> computers, but expressing the part that changes for each new MapReduce >>> task should stay easy. >>> >>> Immutable data by default helps with concurrency. Speed may or may not be >>> the goal. We want to be able to distribute tasks (eg, function calls) >>> across processor cores, and run them in different order, without >>> introducing race conditions. >>> >>> Simon Marlow's book is great at explaining parallel & concurrent >>> concepts, and the particular tools for applying them in Haskell: >>> http://chimera.labs.oreilly.com/books/1230000000929 >>> >>> bergey >>> >>> Footnotes: >>> [1] OK, many changes. >>> >>> _______________________________________________ >>> 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 -- ------------------------------------------------------------------------ Derek Riemer * Department of computer science, third year undergraduate student. * Proud user of the NVDA screen reader. * Open source enthusiast. * Member of Bridge Cu * Avid skiier. Websites: Honors portfolio Non-proffessional website. Awesome little hand built weather app that rocks! email me at derek.riemer at colorado.edu Phone: (303) 906-2194 -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Tue Dec 15 17:04:27 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 15 Dec 2015 18:04:27 +0100 Subject: [Haskell-beginners] IO a, IO b In-Reply-To: References: Message-ID: my apologies. IO b was declared a newtype. After changing it to type, container function seems to work as it is. Please ignore. From jeffbrown.the at gmail.com Tue Dec 15 19:24:56 2015 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Tue, 15 Dec 2015 11:24:56 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: <56704716.7000101@gmail.com> References: <8d5e544f-2ee7-473d-a2bf-5fea3e73fa62@email.android.com> <56704716.7000101@gmail.com> Message-ID: Purity makes type signatures astonishingly informative. Often -- in fact usually! -- one can determine what a function does simply from its name and type signature. The opportunities for bad coding are fewer in Haskell. Before Haskell, I was a proud Python programmer -- proud, thinking I was good at selecting the right way from a forest of wrong ways. In Haskell I find less opportunity for self-congratulation, because most of the wrong ways are no longer available. On Tue, Dec 15, 2015 at 9:00 AM, derek riemer wrote: > Hey guys, > This conversation is really interesting. I am not a haskell expert (I > haven't progressed into monads in haskell yet, and have only briefly > studied the state monad in scala. Studying fp concepts has changed the way > I think about problems that are complicated. I am not quite there yet, (I > still catch myself updating states when I don't need to) and wondering how > the hell to break a problem into recursive little bits. I now notice that I > am less tempted to do things that would have bugs in complicated data > structures , prefer map to do something to a list, and folds to for loops > that update a ``state'' variable, and finally, I can reason about where the > weak points in my code may be. The learning I have achieved do to fp, and > my principals of programming languages class that relied on fp, have made > doing things with code easier because I don't try to do stupid things like > overrun the end of an array with a misplaced loop counter variable. It is > way too easy to learn fold, filter, map, and list comprehensions, you then > have a powerful weapon to use against those ugly off by one errors. > Also, I learned how people who learned programming in non-traditional > languages might think to approach problems earlier this year. My stats > professor was showing us things in r. She showed us a complicated set of > formula that we needed to do, and then explained we were calculating > something to each element of a list. She showed a function sapply(vector, > function(elem)) that returns a vector. She said to think about how sapply > applies that function to each vector element, and returns the transformed > list. She didn't approach it as if it were this big bad function that takes > a function, mainly i think because she hadn't learned programming from > people who insist on the idea of c. It also really made sense to the class > who mainly had little to no programming experience, where explaining a for > loop in all it's glory would normally take a couple of lectures. She is a > really solid programmer and really understands how to use programming to > solve real world problems, so I am not saying that she didn't know enough > to have not learned for loops, just that she immediately realized that the > sapply function really was better for the situation. If we teach people > these patterns from the get go, I think some of the horror of learning > functional programming would be solved because the number of applications > that a generic function can be applied in far outnumbers the number of > cases a for loop or state momad is needed. I would also now argue that all > data structures classes should be taught in functional programming > languages. I never solidly understood trees and could confidently traverse > and change them until I actually got introduced to pattern matching and > folds. I was taught binary search trees, and red-black trees, and worked > with tree like structures, but it was always hard for me to comprehend how > to do things with them. I learned linked lists in c++ but hated them with a > passion because I had to write forloops that updated a temporary variable > and write while loops that did the same, but often jumped off the end of > the list and then I couldn't go back. The beauty of recursion and lists is > that recursion allows you to backtrack when things go wrong (as they always > will for any real input in a program). The second I learned about Haskell > for the first time, linked list traversing became second nature to me, even > in non-functional (inferier) c++. The argument that "recursion results in > overriding the stack" is kind of a flawed one since the compiler wizards > have figured out ways to optimize tail recursive functions to do exactly > what we humans are bad at (running recursive functions as if they were > unrolled, with large inputs, and fast). > Thanks, > Derek > > > On 12/11/2015 11:32 AM, Thomas Jakway wrote: > > Building on that, I think coming to Haskell with a very specific goal in mind (like swap Haskell for Java in my map reduce problem) kind of misses the point. Haskell may or may not be faster/better suited to map reduce vs Java, but the real reason to use/learn Haskell is elegance and correctness. The lack of side effects and referential transparency means you're far more likely to prevent bugs. And there's a pretty substantial learning curve coming from imperative languages so if you need to speed up map reduce on a deadline you will be more productive in the imperative language of your choice (for now). > > Dont take this as discouragement, I think Haskell (and FP in general) is very well suited to that kind of problem. I'm a beginner in Haskell and it's already had a huge impact on how I think about all the code I write, not just the occasional toy Haskell project. > > On Dec 11, 2015 1:08 PM, MJ Williams wrote: > > A pure functional language enables you to reason about your code, > something you can't easily achieve with your average C or Java. And by > `reason' I am referring to mathematical proof. Haskell makes it very > simple, actually. Why should you want to reason about your code? > Think the hassle you could avoid if you knew what your code really > meant and did when executed. > > The absence of side effects is part of another concept in FP, namely, > `referential transparency'. If your function `f' maps a value `x' to > a value `y' then `f x' will always equal `y' and no more. In other > words, your function `f' won't change anything e.g. assign to > variables, or other state changes as well as mapping `x' to `y', and > that's an absolute certainty, in theory, at any rate. > > That's a very crude overview of at least part of what functional > programming is about. I'm hoping it'll encourage others on this list > with far more in-depth knowledge of the subject matter to come in and > fill in the gaps and iron out the ambiguities. > > Matthew > > > On 11/12/2015, Daniel Bergey wrote: > > On 2015-12-11 at 10:07, Abhishek Kumar wrote: > > I am a beginner in haskell.I have heard a lot about haskell being great > for > parallel programming and concurrency but couldn't understand why?Aren't > iterative algorithms like MapReduce more suitable to run parallely?Also > how > immutable data structures add to speed?I'm having trouble understanding > very philosophy of functional programming, how do we gain by writing > everything as functions and pure code(without side effects)? > Any links or references will be a great help. > > Functional languages make it easy to decompose problems in the way that > MapReduce frameworks require. A few examples (fold is another name for > reduce): > > sum :: [Double] -> Double > sum xs = foldr (+) 0 xs > > sumSquares :: [Double] -> Double > sumSquares xs = foldr (+) 0 (map (**2) xs) > > -- foldMap combines the map & fold steps > -- The Monoid instance for String specifies how to combine 2 Strings > -- Unlike numbers, there's only one consistent option > unlines :: [Text] -> Text > unlines xs = foldMap (`snoc` '\n') xs > > We'd need a few changes[1] to make this parallel and distribute across many > computers, but expressing the part that changes for each new MapReduce > task should stay easy. > > Immutable data by default helps with concurrency. Speed may or may not be > the goal. We want to be able to distribute tasks (eg, function calls) > across processor cores, and run them in different order, without > introducing race conditions. > > Simon Marlow's book is great at explaining parallel & concurrent > concepts, and the particular tools for applying them in Haskell: http://chimera.labs.oreilly.com/books/1230000000929 > > bergey > > Footnotes: > [1] OK, many changes. > > _______________________________________________ > 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 listBeginners at haskell.orghttp://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > -- > ------------------------------ > Derek Riemer > > - Department of computer science, third year undergraduate student. > - Proud user of the NVDA screen reader. > - Open source enthusiast. > - Member of Bridge Cu > - Avid skiier. > > Websites: > Honors portfolio > Non-proffessional website. > > Awesome little hand built weather app that rocks! > > > email me at derek.riemer at colorado.edu > Phone: (303) 906-2194 > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Tue Dec 15 20:13:20 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Tue, 15 Dec 2015 12:13:20 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> (Doug McIlroy's message of "Tue, 15 Dec 2015 06:32:26 -0500") References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: Mr. McIlroy, FWIW I would love to read more about that McCarthy talk. It sounds like an amazing experience. > There is no authoritative source about these pragmas. They are listed > and described in the GHC User Guide, but that source all too often > defines solely by example, not even bolstered by a formal syntax > specification. I think it would very helpful simply to better (and more rigorously) document the syntax and semantics of the available extensions. There is currently a call to action to update GHC's Haddock documentation in preparation for the 8.0 release [1]. Perhaps some effort can also be directed towards the documentation of the LANGUAGE pragmas. There is still a problem, though: For completeness, one must consider the interactions of the various subsets of these pragmas, some of which are already known to be unsound. What's worse, the number of extant pragmas already makes an enumeration of these subsets impractical, since there are some 10^31 of them even ignoring the "NoX" pragmas. The only long-term solution then seems to be to codify a new Haskell standard that incorporates some known-good subset of these pragmas that the community seems to agree on, which I suppose is part of the task that the Haskell Prime committee has before them. I do not envy them. [1]: https://mail.haskell.org/pipermail/ghc-devs/2015-December/010681.html From rein.henrichs at gmail.com Tue Dec 15 21:00:42 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Tue, 15 Dec 2015 13:00:42 -0800 Subject: [Haskell-beginners] Monad and bind operator interpretation In-Reply-To: (Raja's message of "Mon, 14 Dec 2015 12:49:12 -0500") References: Message-ID: Raja writes: > Now my new hypothetical interpretation becomes: > > (>>=) :: (a -> m b) -> m a -> m b You have independently discovered (=<<), which is excellent news! > If i further add parens: > > (>>=) (a -> m b) -> (m a -> m b) > > This allows me to slightly tweak my interpretation: > > bind takes one param f (of type a -> m b) and returns another param f (of type m > a -> m b) > > This feels like a more intuitive way to think about Monads - am I on the right > track? > (not that I want to switch the params permanently - just trying to get a feel > for monads) Yes, you are absolutely on the right track. One way to interpret bind is as a particular way to abstract function application. Consider these types: ($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b (=<<) :: Monad m => (a -> m b) -> m a -> m b All of them take a particular type of function and "lift" it to apply to a particular type of value. ($) performs an "identity lift", which is to say that it does no lifting at all[1]. (<$>), aka fmap, lifts functions to apply "in" a Functor "context". (=<<) lifts functions (of a certain type) to apply in a Monad context. (The ability to talk about these sorts of abstract functions is one of the motivations of Category Theory, not that you need to know CT to do Haskell.) Note also that these are listed in strictly increasing order of expressiveness, which is to say that a later operator can do anything that an earlier operator can do, but not vice versa[2]. If you explore exactly what (=<<) can do that fmap cannot, you may learn something else about monads! [1]: By the way, you can also define ($) as id. id f = f is exactly the "identity lift" that I am taliking about! Using your "add parens" interpretation, ($) takes an (a -> b) and gives an (a -> b) (the same one you gave it). [2]: As long as you admit that Identity x is equivalent to x. From gesh at gesh.uni.cx Wed Dec 16 07:57:21 2015 From: gesh at gesh.uni.cx (Gesh) Date: Wed, 16 Dec 2015 09:57:21 +0200 Subject: [Haskell-beginners] Extend instance for List In-Reply-To: References: <566E4C37.1030805@gmail.com> <99BD0A81-6FBC-4F61-BE68-450697CC8A4F@gesh.uni.cx> <566EFFAC.3030006@gmail.com> Message-ID: <8124DBEE-4285-41D5-A6E1-99E539811F1A@gesh.uni.cx> On December 15, 2015 12:36:58 PM GMT+02:00, Kim-Ee Yeoh wrote: >On Tue, Dec 15, 2015 at 12:43 AM, Graham Gill >wrote: > >I guessed that the correct Extend instance for List is needed for >Comonad, >> but didn't have any intuition about it. >> > >List is not comonadic. In this case, the function copure must be of >type >[a] -> a, which must necessarily be partial. > >(Non-empty lists, on the other hand, are comonadic.) In fact, it seems this distinction is true of any type that has an empty case, i.e. f s.t. exists g. f a = 1 + g a. What blinded me was the fact that for such types, usually the definition of extend extends naturally to the empty case. So obviously the possibly-empty types have an Extend instance inherited from their nonempty counterparts, but it is only the latter who have Comonad instances. >Graham's "Extend" -- I'll explain the scare quotes in a minute -- >instance >for List obeys the associative law. So it's a valid instance but a bit >boring. The exercise asks for an interesting instance. Indeed, the same problem exists dually for Monad, where one can force the empty case always and obtain a Monad isomorphic to Const (). Thanks for the correction and illumination, Gesh >The way the NICTA course is structured, there's no mention of the >> dependence between "extend" and "copure" (equivalent to extract and >> duplicate I suppose) via the Comonad laws when considering Extend >first by >> itself. >> > >It's a bit terse, but you can find "class Extend f => Comonad f" in >Comonad.hs. After all, we're only looking at the exercises. The live >lecture version probably does talk about the dependence. > > >> I'm not knocking the NICTA course. I've found it useful. A quick >paragraph >> or two as you've written, stuck into the source files as comments, >would >> improve it. >> > >Most folks are neutral about the course. If parts of it work for you, >great. If not, no worries. The whole comonadic business is a bit >obscure >and some of the strongest haskell programmers don't bat an eyelid over >not >knowing it. > >p.s. "Extend" doesn't agree with the CT literature. See the paragraph >that >starts "The dual problem is the problem of lifting a morphism" here: > >http://ncatlab.org/nlab/show/extension > >But calling it a "lift" or "lifting" will only add to the confusion >since >monad transformers got first dibs on the terminology. Which is why you >sometimes see "coextend" or (for the flipped version) "cobind". > > >-- Kim-Ee > > >------------------------------------------------------------------------ > >_______________________________________________ >Beginners mailing list >Beginners at haskell.org >http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From objitsu at gmail.com Wed Dec 16 09:58:24 2015 From: objitsu at gmail.com (emacstheviking) Date: Wed, 16 Dec 2015 09:58:24 +0000 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: I'm firmly with Derek.. we should teach people things like maps, folds and generic recursion instead of subjecting them to stuff like Java or C++. I'm not starting a war here, just stating that after 30+ years in software, mentoring and helping people learn... that, like teaching your kid to read or play guitar... the magic just happens. They learn and you don't know how they learned but they take it in and build on it. By not clouding impressionable learning minds with the gory details for for loops and such like but instead immediately beginning their programming lives with maps folds and recursion I think we would be raising the level of goodness... then maybe Haskell would be taught in schools! I taught myself prolog a year or three back...thanks to my FP skills, concepts like recursion were a done deal and backtracking was not that hard to take on board. Maybe we should teach Prolog as the first language people ever learn! Regarding language pragmas. Yes!!! A complete hitch-hikers guide with information examples would be good. I have often tried to work with code I find only realise that the author had used the "automatically munge strings to be the right type" option and not mentioned it. Whatever. Haskell started in '98, it's 2016 now... it's going to last! :) Sean On 15 December 2015 at 20:13, Rein Henrichs wrote: > > Mr. McIlroy, > > FWIW I would love to read more about that McCarthy talk. It > sounds like an amazing experience. > > > There is no authoritative source about these pragmas. They are listed > > and described in the GHC User Guide, but that source all too often > > defines solely by example, not even bolstered by a formal syntax > > specification. > > I think it would very helpful simply to better (and more rigorously) > document the syntax and semantics of the available extensions. There is > currently a call to action to update GHC's Haddock documentation in > preparation for the 8.0 release [1]. Perhaps some effort can also be > directed towards the documentation of the LANGUAGE pragmas. > > There is still a problem, though: For completeness, one must consider > the interactions of the various subsets of these pragmas, some of which > are already known to be unsound. What's worse, the number of extant > pragmas already makes an enumeration of these subsets impractical, since > there are some 10^31 of them even ignoring the "NoX" pragmas. > > The only long-term solution then seems to be to codify a new Haskell > standard that incorporates some known-good subset of these pragmas that > the community seems to agree on, which I suppose is part of the task > that the Haskell Prime committee has before them. I do not envy them. > > [1]: https://mail.haskell.org/pipermail/ghc-devs/2015-December/010681.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 lorenzo.isella at gmail.com Thu Dec 17 10:37:24 2015 From: lorenzo.isella at gmail.com (Lorenzo Isella) Date: Thu, 17 Dec 2015 11:37:24 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis Message-ID: <20151217103724.GA3383@localhost.localdomain> Dear All, I am trying to learn Haskell (for the second time), but I have to admit I am still struggling with relative simple stuff, so I ask if anybody can give me a hand. I am dealing with the issues of extracting info out of some rose trees and probably I am also having some troubles with the notation. The rose tree is defined with the following notation data Rose a = a :> [Rose a] deriving (Eq, Show) and the root can be detected simply as root (a :> rs) = a I would like to have the expression (with the ":>" notation for the Node) of the function to find the children of the root. Example of expected behavior of this function children children (1 :> [2 :> [], 3 :> []]) = [2 :> [], 3 :> []] On top of that, I am trying to get the functions to have the functions size :: Rose a -> Int leaves :: Rose a -> Int that count the number of nodes in a rose tree, respectively the number of leaves (nodes without any children). For the children function, I have tried stuff like children (a :> rs) = rs quite unsuccessfully. Any suggestion is appreciated. Cheers Lorenzo From hjgtuyl at chello.nl Thu Dec 17 11:10:01 2015 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Thu, 17 Dec 2015 12:10:01 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: <20151217103724.GA3383@localhost.localdomain> References: <20151217103724.GA3383@localhost.localdomain> Message-ID: On Thu, 17 Dec 2015 11:37:24 +0100, Lorenzo Isella wrote: : > > data Rose a = a :> [Rose a] > deriving (Eq, Show) > > and the root can be detected simply as > > root (a :> rs) = a > > I would like to have the expression (with the ":>" notation for the > Node) of the function to find the children of the root. Example of > expected behavior of this function children > > children (1 :> [2 :> [], 3 :> []]) = [2 :> [], 3 :> []] > > On top of that, I am trying to get the functions to have the functions > > size :: Rose a -> Int > leaves :: Rose a -> Int > > that count the number of nodes in a rose tree, respectively the number > of leaves (nodes without any children). > For the children function, I have tried stuff like > > children (a :> rs) = rs > > quite unsuccessfully. : Your definition of children is correct, what is the message you get from the compiler/interpreter? Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From chak at justtesting.org Fri Dec 18 07:27:13 2015 From: chak at justtesting.org (Manuel M T Chakravarty) Date: Fri, 18 Dec 2015 18:27:13 +1100 Subject: [Haskell-beginners] Learning Haskell: Algebraic Data Types Message-ID: The latest chapter of our ?Learning Haskell? tutorial takes a first stab at algebraic data types ? there will be a second chapter continuing the topic sometime soon: http://blog.haskellformac.com/blog/algebraic-data-types-demystified Happy Coding! Manuel From lorenzo.isella at gmail.com Sun Dec 20 12:06:04 2015 From: lorenzo.isella at gmail.com (Lorenzo Isella) Date: Sun, 20 Dec 2015 13:06:04 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: References: <20151217103724.GA3383@localhost.localdomain> Message-ID: <20151220120604.GB2446@localhost.localdomain> On Thu, Dec 17, 2015 at 12:10:01PM +0100, Henk-Jan van Tuyl wrote: >On Thu, 17 Dec 2015 11:37:24 +0100, Lorenzo Isella > wrote: >: >> >>data Rose a = a :> [Rose a] >>deriving (Eq, Show) >> >>and the root can be detected simply as >> >>root (a :> rs) = a >> >>I would like to have the expression (with the ":>" notation for the >>Node) of the function to find the children of the root. Example of >>expected behavior of this function children >> >>children (1 :> [2 :> [], 3 :> []]) = [2 :> [], 3 :> []] >> >>On top of that, I am trying to get the functions to have the functions >> >> size :: Rose a -> Int >> leaves :: Rose a -> Int >> >>that count the number of nodes in a rose tree, respectively the number >>of leaves (nodes without any children). >>For the children function, I have tried stuff like >> >>children (a :> rs) = rs >> >>quite unsuccessfully. >: > >Your definition of children is correct, what is the message you get >from the compiler/interpreter? > >Regards, >Henk-Jan van Tuyl Hello, This is the situation: my script rose.hs is given by data Rose a = a :> [Rose a] root (a :> rs) = a children (a :> rs) = rs and this is what happens when I load it and apply the children function on a rose tree $ ghci GHCi, version 7.8.4: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :load rose.hs [1 of 1] Compiling Main ( rose.hs, interpreted ) Ok, modules loaded: Main. *Main> children (1 :> [2 :> [], 3 :> []]) :3:1: No instance for (Show (Rose t0)) arising from a use of ?print? In a stmt of an interactive GHCi command: print it I do not really understand what goes wrong and any suggestion is appreciated. Cheers Lorenzo From imantc at gmail.com Sun Dec 20 12:14:56 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 20 Dec 2015 13:14:56 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: <20151220120604.GB2446@localhost.localdomain> References: <20151217103724.GA3383@localhost.localdomain> <20151220120604.GB2446@localhost.localdomain> Message-ID: > No instance for (Show (Rose t0)) arising from a use of ?print? try data Rose a = a :> [Rose a] deriving Show From rustompmody at gmail.com Sun Dec 20 16:39:22 2015 From: rustompmody at gmail.com (Rustom Mody) Date: Sun, 20 Dec 2015 22:09:22 +0530 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: On Wed, Dec 16, 2015 at 1:43 AM, Rein Henrichs wrote: > > Mr. McIlroy, > > FWIW I would love to read more about that McCarthy talk. It > sounds like an amazing experience. > > No I was not there (in more than one sense!) when that talk happened About the power of scheme being under-appreciated (even by the authors of SICP!) http://blog.languager.org/2013/08/applying-si-on-sicp.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin at vlkk.cz Sun Dec 20 17:24:18 2015 From: martin at vlkk.cz (Martin Vlk) Date: Sun, 20 Dec 2015 17:24:18 +0000 Subject: [Haskell-beginners] Problem reading sound data from mic with TChan Message-ID: <5676E442.2080700@vlkk.cz> Hi, I am working on a little toy project related to controlling graphics display based on data from the computer microphone. I am basing the whole thing on concepts from game programming, so I have a main loop which reads inputs, updates the world state and generates outputs. As part of inputs there is microphone. I read data from it using the pulse-simple library. The "simpleRead" function blocks if there is not enough data available so I can't use it directly in the main loop or I risk delays. So I figured I'll use a separate thread to read from the mic and write data into a TChan. The main loop in separate thread then can read from the TChan as needed and test for availability of data to avoid delaying the main loop. Here is my current code: http://lpaste.net/147522 The data is written into TChan in the "handleMic" function and read from the TChan on line 85. The problem I have is that the TChan never seems to contain any data when I read from it and that confuses me. Why? Does anyone see where is my problem? Many Thanks Martin From lorenzo.isella at gmail.com Sun Dec 20 19:59:54 2015 From: lorenzo.isella at gmail.com (Lorenzo Isella) Date: Sun, 20 Dec 2015 20:59:54 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: References: <20151217103724.GA3383@localhost.localdomain> Message-ID: <20151220195954.GB3649@localhost.localdomain> Dear All, This is where I stand now. Please consider the short snippet data Rose a = a :> [Rose a] deriving (Eq, Show) root (a :> rs) = a children (a :> rs) = rs size :: Rose a -> Int size (a :> rs) = 1 + (length $ children (a :> rs)) which defines a rose tree structure and the functions to get the root, the children and the size (i.e. number of nodes) of the rose tree. I would like to find the number of leaves (i.e. terminal nodes) in my rose tree. Essentially, I need to count the number of "[]" inside my rose tree definition. For instance, consider mytree = (1 :> [2 :> [], 3 :> []]) which has exactly two leaves. Can anyone help me implement a function to get the number of leaves? Many thanks Lorenzo From verdier.jean at gmail.com Sun Dec 20 23:22:39 2015 From: verdier.jean at gmail.com (jean verdier) Date: Mon, 21 Dec 2015 00:22:39 +0100 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: <20151220195954.GB3649@localhost.localdomain> References: <20151217103724.GA3383@localhost.localdomain> <20151220195954.GB3649@localhost.localdomain> Message-ID: <1450653759.1859.8.camel@gmail.com> I think that your definition of size is not what you say it is. I guess that you expect (size (1 :> [2 :> [ 3 :> [] ] ])) to be 3. To count leaves you may start with something like: countleaves (_ :> []) = 1 You have then to define countleaves for the case it's not a leaf. I hope this is of some help. On Sun, 2015-12-20 at 20:59 +0100, Lorenzo Isella wrote: > Dear All, > This is where I stand now. Please consider the short snippet > > data Rose a = a :> [Rose a] > deriving (Eq, Show) > > root (a :> rs) = a > > children (a :> rs) = rs > > size :: Rose a -> Int > > size (a :> rs) = 1 + (length $ children (a :> rs)) > > which defines a rose tree structure and the functions to get the > root, the children and the size (i.e. number of nodes) of the rose > tree. > I would like to find the number of leaves (i.e. terminal nodes) in my > rose tree. > Essentially, I need to count the number of "[]" inside my rose tree > definition. > For instance, consider > > mytree = (1 :> [2 :> [], 3 :> []]) > > which has exactly two leaves. > Can anyone help me implement a function to get the number of leaves? > Many thanks > > Lorenzo > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From dedgrant at gmail.com Sun Dec 20 23:27:50 2015 From: dedgrant at gmail.com (Darren Grant) Date: Sun, 20 Dec 2015 15:27:50 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: Lacking intentional syntax for function application is much more profound than I would have expected. Cheers, Darren On Dec 20, 2015 08:39, "Rustom Mody" wrote: > > > On Wed, Dec 16, 2015 at 1:43 AM, Rein Henrichs > wrote: > >> >> Mr. McIlroy, >> >> FWIW I would love to read more about that McCarthy talk. It >> sounds like an amazing experience. >> >> > No I was not there (in more than one sense!) when that talk happened > > About the power of scheme being under-appreciated (even by the authors of > SICP!) > > http://blog.languager.org/2013/08/applying-si-on-sicp.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 lukexipd at gmail.com Mon Dec 21 01:38:49 2015 From: lukexipd at gmail.com (Luke Iannini) Date: Sun, 20 Dec 2015 17:38:49 -0800 Subject: [Haskell-beginners] Problem reading sound data from mic with TChan In-Reply-To: <5676E442.2080700@vlkk.cz> References: <5676E442.2080700@vlkk.cz> Message-ID: Hi Martin, On line 63 http://lpaste.net/147522#line63, when you do let sndChan = newTChan you're not actually creating a new TChan, but rather creating a reference to the STM action that creates new TChans. So this means that e.g. on line 71 http://lpaste.net/147522#line71, you are creating a new channel every time with ch <- sndChan Instead, you want to do: sndChan <- newTChanIO (or, sndChan <- atomically newTChan ) And then pass that value to your other functions, which will just take TChan [Int32] rather than STM (TChan [Int32]) Here's what I mean: http://lpaste.net/diff/147522/147557 Hope that helps! On Sun, Dec 20, 2015 at 9:24 AM, Martin Vlk wrote: > Hi, I am working on a little toy project related to controlling graphics > display based on data from the computer microphone. > > I am basing the whole thing on concepts from game programming, so I have > a main loop which reads inputs, updates the world state and generates > outputs. > > As part of inputs there is microphone. I read data from it using the > pulse-simple library. The "simpleRead" function blocks if there is not > enough data available so I can't use it directly in the main loop or I > risk delays. > > So I figured I'll use a separate thread to read from the mic and write > data into a TChan. The main loop in separate thread then can read from > the TChan as needed and test for availability of data to avoid delaying > the main loop. > > Here is my current code: http://lpaste.net/147522 > > The data is written into TChan in the "handleMic" function and read from > the TChan on line 85. > > The problem I have is that the TChan never seems to contain any data > when I read from it and that confuses me. Why? > > Does anyone see where is my problem? > > Many Thanks > Martin > _______________________________________________ > 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 cma at bitemyapp.com Mon Dec 21 02:01:13 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Sun, 20 Dec 2015 20:01:13 -0600 Subject: [Haskell-beginners] Problem reading sound data from mic with TChan In-Reply-To: References: <5676E442.2080700@vlkk.cz> Message-ID: https://github.com/bitemyapp/blacktip/blob/master/src/Database/Blacktip.hs#L47-L54 :) On Sun, Dec 20, 2015 at 7:38 PM, Luke Iannini wrote: > Hi Martin, > > On line 63 http://lpaste.net/147522#line63, when you do > > let sndChan = newTChan > > > you're not actually creating a new TChan, but rather creating a reference to the STM action that creates new TChans. > > > So this means that e.g. on line 71 http://lpaste.net/147522#line71, you are creating a new channel every time with > > ch <- sndChan > > > Instead, you want to do: > > sndChan <- newTChanIO > > (or, > > sndChan <- atomically newTChan > > ) > > > And then pass that value to your other functions, which will just take TChan [Int32] rather than STM (TChan [Int32]) > > > Here's what I mean: > > http://lpaste.net/diff/147522/147557 > > > Hope that helps! > > > > On Sun, Dec 20, 2015 at 9:24 AM, Martin Vlk wrote: > >> Hi, I am working on a little toy project related to controlling graphics >> display based on data from the computer microphone. >> >> I am basing the whole thing on concepts from game programming, so I have >> a main loop which reads inputs, updates the world state and generates >> outputs. >> >> As part of inputs there is microphone. I read data from it using the >> pulse-simple library. The "simpleRead" function blocks if there is not >> enough data available so I can't use it directly in the main loop or I >> risk delays. >> >> So I figured I'll use a separate thread to read from the mic and write >> data into a TChan. The main loop in separate thread then can read from >> the TChan as needed and test for availability of data to avoid delaying >> the main loop. >> >> Here is my current code: http://lpaste.net/147522 >> >> The data is written into TChan in the "handleMic" function and read from >> the TChan on line 85. >> >> The problem I have is that the TChan never seems to contain any data >> when I read from it and that confuses me. Why? >> >> Does anyone see where is my problem? >> >> Many Thanks >> Martin >> _______________________________________________ >> 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 > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From davidleothomas at gmail.com Mon Dec 21 02:57:24 2015 From: davidleothomas at gmail.com (David Thomas) Date: Sun, 20 Dec 2015 18:57:24 -0800 Subject: [Haskell-beginners] Questions About Rose Trees Analysis In-Reply-To: <20151220120604.GB2446@localhost.localdomain> References: <20151217103724.GA3383@localhost.localdomain> <20151220120604.GB2446@localhost.localdomain> Message-ID: It seems to me like there might be benefit to special casing the error message when (as in this case) the only thing wrong with an expression is that the resulting type is missing the Show instance implicitly demanded by ghci. On Sun, Dec 20, 2015 at 4:06 AM, Lorenzo Isella wrote: > On Thu, Dec 17, 2015 at 12:10:01PM +0100, Henk-Jan van Tuyl wrote: >> >> On Thu, 17 Dec 2015 11:37:24 +0100, Lorenzo Isella >> wrote: >> : >>> >>> >>> data Rose a = a :> [Rose a] >>> deriving (Eq, Show) >>> >>> and the root can be detected simply as >>> >>> root (a :> rs) = a >>> >>> I would like to have the expression (with the ":>" notation for the >>> Node) of the function to find the children of the root. Example of >>> expected behavior of this function children >>> >>> children (1 :> [2 :> [], 3 :> []]) = [2 :> [], 3 :> []] >>> >>> On top of that, I am trying to get the functions to have the functions >>> >>> size :: Rose a -> Int >>> leaves :: Rose a -> Int >>> >>> that count the number of nodes in a rose tree, respectively the number >>> of leaves (nodes without any children). >>> For the children function, I have tried stuff like >>> >>> children (a :> rs) = rs >>> >>> quite unsuccessfully. >> >> : >> >> Your definition of children is correct, what is the message you get from >> the compiler/interpreter? >> >> Regards, >> Henk-Jan van Tuyl > > > > Hello, > This is the situation: my script rose.hs is given by > > > data Rose a = a :> [Rose a] > > root (a :> rs) = a > > children (a :> rs) = rs > > > and this is what happens when I load it and apply the children > function on a rose tree > > > $ ghci > GHCi, version 7.8.4: http://www.haskell.org/ghc/ :? for help > Loading package ghc-prim ... linking ... done. > Loading package integer-gmp ... linking ... done. > Loading package base ... linking ... done. > Prelude> :load rose.hs > [1 of 1] Compiling Main ( rose.hs, interpreted ) > Ok, modules loaded: Main. > *Main> children (1 :> [2 :> [], 3 :> []]) > > :3:1: > No instance for (Show (Rose t0)) arising from a use of ?print? > In a stmt of an interactive GHCi command: print it > > > I do not really understand what goes wrong and any suggestion is > appreciated. > Cheers > > Lorenzo > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From martin at vlkk.cz Mon Dec 21 07:07:10 2015 From: martin at vlkk.cz (Martin Vlk) Date: Mon, 21 Dec 2015 07:07:10 +0000 Subject: [Haskell-beginners] Problem reading sound data from mic with TChan In-Reply-To: References: <5676E442.2080700@vlkk.cz> Message-ID: <5677A51E.9060709@vlkk.cz> Oh doh, #@!"%^ damn it! ;-) Yes, you are absolutely right, many thanks for the help! Martin Luke Iannini: > Hi Martin, > > On line 63 http://lpaste.net/147522#line63, when you do > > let sndChan = newTChan > > > you're not actually creating a new TChan, but rather creating a > reference to the STM action that creates new TChans. > > > So this means that e.g. on line 71 http://lpaste.net/147522#line71, > you are creating a new channel every time with > > ch <- sndChan > > > Instead, you want to do: > > sndChan <- newTChanIO > > (or, > > sndChan <- atomically newTChan > > ) > > > And then pass that value to your other functions, which will just take > TChan [Int32] rather than STM (TChan [Int32]) > > > Here's what I mean: > > http://lpaste.net/diff/147522/147557 > > > Hope that helps! > > > > On Sun, Dec 20, 2015 at 9:24 AM, Martin Vlk wrote: > >> Hi, I am working on a little toy project related to controlling graphics >> display based on data from the computer microphone. >> >> I am basing the whole thing on concepts from game programming, so I have >> a main loop which reads inputs, updates the world state and generates >> outputs. >> >> As part of inputs there is microphone. I read data from it using the >> pulse-simple library. The "simpleRead" function blocks if there is not >> enough data available so I can't use it directly in the main loop or I >> risk delays. >> >> So I figured I'll use a separate thread to read from the mic and write >> data into a TChan. The main loop in separate thread then can read from >> the TChan as needed and test for availability of data to avoid delaying >> the main loop. >> >> Here is my current code: http://lpaste.net/147522 >> >> The data is written into TChan in the "handleMic" function and read from >> the TChan on line 85. >> >> The problem I have is that the TChan never seems to contain any data >> when I read from it and that confuses me. Why? >> >> Does anyone see where is my problem? >> >> Many Thanks >> Martin >> _______________________________________________ >> 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 martin.drautzburg at web.de Mon Dec 21 09:40:28 2015 From: martin.drautzburg at web.de (martin) Date: Mon, 21 Dec 2015 10:40:28 +0100 Subject: [Haskell-beginners] How to nest arbitrary things Message-ID: <5677C90C.3010205@web.de> Hello all, I was trying to model things which can contain other things. This is easy as long as containers and the contained items all can be described in the same fashion. However when I want to model - say - trucks containing boxes containing parcels containing cans and trucks, boxes, parcels and cans are not of the same type, then this nested thing will become a type in its own right and it will be of a different type than trucks containing cans (which are not wrappen in parcels ...) As long as I can squeeze trucks, boxes ... into one type, possibly by using a "container_type" attribute, there is no problem. Is this the only way to do this? Is there an idiom? From magnus at therning.org Mon Dec 21 13:33:59 2015 From: magnus at therning.org (Magnus Therning) Date: Mon, 21 Dec 2015 14:33:59 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <5677C90C.3010205@web.de> References: <5677C90C.3010205@web.de> Message-ID: <8760zs53js.fsf@sobel.cipherstone.com> martin writes: > Hello all, > > I was trying to model things which can contain other things. This is > easy as long as containers and the contained items all can be > described in the same fashion. However when I want to model - say - > > trucks > containing boxes > containing parcels > containing cans > > and trucks, boxes, parcels and cans are not of the same type, then > this nested thing will become a type in its own right and it will be > of a different type than trucks containing cans (which are not wrappen > in parcels ...) > > As long as I can squeeze trucks, boxes ... into one type, possibly by > using a "container_type" attribute, there is no problem. Is this the > only way to do this? Is there an idiom? Well, you can always make Truck a bit generic: data Truck a = Truck [a] Then you have have a truck of boxes (`Truck Box`) or a truck of cans (`Truck Can`). But maybe that's not really your question? /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus Any sufficiently advanced technology is indistinguishable from a rigged demo. -- Andy Finkel -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 800 bytes Desc: not available URL: From imantc at gmail.com Mon Dec 21 13:51:08 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 14:51:08 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <8760zs53js.fsf@sobel.cipherstone.com> References: <5677C90C.3010205@web.de> <8760zs53js.fsf@sobel.cipherstone.com> Message-ID: > trucks containing boxes containing parcels containing cans .. or try this type: data Item a = Truck a [Item] | Box a [Item] | Parcel a [Item] | Can a [Item] "a" here is a property you may use to identify each Item e.g. String From raabe at froglogic.com Mon Dec 21 13:54:32 2015 From: raabe at froglogic.com (Frerich Raabe) Date: Mon, 21 Dec 2015 14:54:32 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: References: <5677C90C.3010205@web.de> <8760zs53js.fsf@sobel.cipherstone.com> Message-ID: <15399aa916da5ae705bbbb3bc38d5136@roundcube.froglogic.com> On 2015-12-21 14:51, Imants Cekusins wrote: >> trucks > containing boxes > containing parcels > containing cans > > > .. or try this type: > > data Item a = Truck a [Item] | Box a [Item] | Parcel a [Item] | Can a [Item] I guess you'd need that type if you want to be able to express http://i.telegraph.co.uk/multimedia/archive/01845/truck-on-truck-on-_1845173i.jpg -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From ky3 at atamo.com Mon Dec 21 13:58:38 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Mon, 21 Dec 2015 20:58:38 +0700 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: References: <5677C90C.3010205@web.de> <8760zs53js.fsf@sobel.cipherstone.com> Message-ID: On Mon, Dec 21, 2015 at 8:51 PM, Imants Cekusins wrote: data Item a = Truck a [Item] | Box a [Item] | Parcel a [Item] | Can a [Item] A cardinal rule of FP data modelling is to avoid the hazards of junk, a.k.a. make the meaningless unspeakable. Here an Item could be a Can that contains a Parcel that contains a Box that in turn has a Truck inside. What will Item-processing functions do with this Item? Garbage In Garbage Out. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Dec 21 13:59:55 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 14:59:55 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <15399aa916da5ae705bbbb3bc38d5136@roundcube.froglogic.com> References: <5677C90C.3010205@web.de> <8760zs53js.fsf@sobel.cipherstone.com> <15399aa916da5ae705bbbb3bc38d5136@roundcube.froglogic.com> Message-ID: > http://i.telegraph.co.uk/multimedia/archive/01845/truck-on-truck-on-_1845173i.jpg :D > Garbage In Garbage Out. well Martin would like to > model things which can contain other things. From toad3k at gmail.com Mon Dec 21 14:07:57 2015 From: toad3k at gmail.com (David McBride) Date: Mon, 21 Dec 2015 09:07:57 -0500 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <5677C90C.3010205@web.de> References: <5677C90C.3010205@web.de> Message-ID: Personally I'd try to use the type system, if possible. data Box a = Box [a] data Parcel a = Parcel [a] data Can = Can data Truck a = Truck { tname :: String, truckContents :: [a] } oneboxoftwocanstruck :: Truck (Box Can) oneboxoftwocanstruck = Truck "Truck of Boxes of Cans" [Box [Can,Can]] onecantruck :: Truck Can onecantruck = Truck "Truck of Cans" [Can] This gets some of the type safety without bogging you down too much. You can still end up with parcels with trucks in them, but it's not too bad. At least cans are just cans, and functions can be written for trucks that only work on trucks, for example. On Mon, Dec 21, 2015 at 4:40 AM, martin wrote: > Hello all, > > I was trying to model things which can contain other things. This is easy > as long as containers and the contained items > all can be described in the same fashion. However when I want to model - > say - > > trucks > containing boxes > containing parcels > containing cans > > and trucks, boxes, parcels and cans are not of the same type, then this > nested thing will become a type in its own right > and it will be of a different type than trucks containing cans (which are > not wrappen in parcels ...) > > As long as I can squeeze trucks, boxes ... into one type, possibly by > using a "container_type" attribute, there is no > problem. Is this the only way to do this? Is there an idiom? > > _______________________________________________ > 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 raabe at froglogic.com Mon Dec 21 14:21:11 2015 From: raabe at froglogic.com (Frerich Raabe) Date: Mon, 21 Dec 2015 15:21:11 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <5677C90C.3010205@web.de> References: <5677C90C.3010205@web.de> Message-ID: <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> On 2015-12-21 10:40, martin wrote: > I was trying to model things which can contain other things. This is easy as > long as containers and the contained items > all can be described in the same fashion. However when I want to model - say > - > > trucks > containing boxes > containing parcels > containing cans > > and trucks, boxes, parcels and cans are not of the same type, then this > nested thing will become a type in its own right > and it will be of a different type than trucks containing cans (which are > not wrappen in parcels ...) > > As long as I can squeeze trucks, boxes ... into one type, possibly by using > a "container_type" attribute, there is no > problem. Is this the only way to do this? Is there an idiom? In addition to what the others wrote (I'd personally probably start with the 'data Truck a = Truck [a]' idea) you could also use the type system to express the possible *legal* ways to nest the load of a truck, e.g.: -- A Can can't contain anything data Can = Can -- A Parcel consists of zero or more cans data Parcel = Parcel [Can] -- A Box can be empty or contain a mixture of cans and parcels data BoxContent = BCCan Can | BCParcel Parcel data Box = Box [BoxContent] -- A Truck can be empty or contain a mixture of cans, parcels and boxes data TruckConent = TCCan Can | TCParcel Parcel | TCBox Box data Truck = Truck [TruckContent] This might be too annoying to deal with though, i.e. the gain of type safety is not big enough to actually follow this path. -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From martin.drautzburg at web.de Mon Dec 21 17:00:06 2015 From: martin.drautzburg at web.de (martin) Date: Mon, 21 Dec 2015 18:00:06 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> References: <5677C90C.3010205@web.de> <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> Message-ID: <56783016.4010302@web.de> Am 12/21/2015 um 03:21 PM schrieb Frerich Raabe: > On 2015-12-21 10:40, martin wrote: >> I was trying to model things which can contain other things. This is easy as long as containers and the contained items >> all can be described in the same fashion. However when I want to model - say - >> >> trucks >> containing boxes >> containing parcels >> containing cans >> >> and trucks, boxes, parcels and cans are not of the same type, then this nested thing will become a type in its own right >> and it will be of a different type than trucks containing cans (which are not wrappen in parcels ...) >> >> As long as I can squeeze trucks, boxes ... into one type, possibly by using a "container_type" attribute, there is no >> problem. Is this the only way to do this? Is there an idiom? > > In addition to what the others wrote (I'd personally probably start with the 'data Truck a = Truck [a]' idea) you could > also use the type system to express the possible *legal* ways to nest the load of a truck, e.g.: > > -- A Can can't contain anything > data Can = Can > > -- A Parcel consists of zero or more cans > data Parcel = Parcel [Can] > > -- A Box can be empty or contain a mixture of cans and parcels > data BoxContent = BCCan Can | BCParcel Parcel > data Box = Box [BoxContent] > > -- A Truck can be empty or contain a mixture of cans, parcels and boxes > data TruckConent = TCCan Can | TCParcel Parcel | TCBox Box > data Truck = Truck [TruckContent] > > This might be too annoying to deal with though, i.e. the gain of type safety is not big enough to actually follow this > path. > That's fine. I'm happy not to be able to pack a truck into another truck. Only problem is that I don't know how to write an "unpack" function, which removes one level of nesting. I can only write unpackTruck, unpackParcel ... I suppose the ability to write a generic unpack function implies that there can be a generic pack function and then I could pack a truck into another truck. From fa-ml at ariis.it Mon Dec 21 17:30:13 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 21 Dec 2015 18:30:13 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <56783016.4010302@web.de> References: <5677C90C.3010205@web.de> <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> <56783016.4010302@web.de> Message-ID: <20151221173013.GA17263@casa.casa> On Mon, Dec 21, 2015 at 06:00:06PM +0100, martin wrote: > That's fine. I'm happy not to be able to pack a truck into another truck. > Only problem is that I don't know how to write an "unpack" function, > which removes one level of nesting. I can only write unpackTruck, > unpackParcel ... > > I suppose the ability to write a generic unpack function implies that > there can be a generic pack function and then I could pack a truck into > another truck. I would say typeclasses might help you, but before that, what would the unpack function signature look like? unpack :: (Package s) => s a -> [a] Like this? If so, I don't see much benefit (or what problem we're trying to solve) in trucks>boxes>parcels>cans types. From imantc at gmail.com Mon Dec 21 17:47:54 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 18:47:54 +0100 Subject: [Haskell-beginners] How to nest arbitrary things Message-ID: > how to write an "unpack" function is this what Lenses are all about? https://www.fpcomplete.com/school/to-infinity-and-beyond/pick-of-the-week/a-little-lens-starter- tutorial I stumbled across Lenses only recently so can not write a working example yet. if Lenses are relevant to this topic, could someone kindly post an appropriate (Truck Parcel Can) datatype and an "unpack" with Lenses example? From 50295 at web.de Mon Dec 21 18:56:36 2015 From: 50295 at web.de (Olumide) Date: Mon, 21 Dec 2015 18:56:36 +0000 Subject: [Haskell-beginners] Pattern matching is actually about matching constructors?? Message-ID: <56784B64.1010509@web.de> Hello, On chapter 7 of LYH there's an example of a user-defined operator .++ infixr 5 .++ (.++) :: List a -> List a -> List a Empty .++ ys = ys (x :-: xs) .++ ys = x :-: (xs .++ ys) which is used as follows let a = 3 :-: 4 :-: 5 :-: Empty let b = 6 :-: 7 :-: Empty a .++ b (:-:) 3 ((:-:) 4 ((:-:) 5 ((:-:) 6 ((:-:) 7 Empty)))) Following this the text reads: "Notice how we pattern matched on (x :-: xs). That works because pattern matching is actually about matching constructors. We can match on :-: because it is a constructor for our own list type ..." Source: http://learnyouahaskell.com/making-our-own-types-and-typeclasses#recursive-data-structures Is the operator :-: a constructor? I'm confused because the definition of :-: is not prefixed by the data keyword? - Olumide From petr.vapenka at gmail.com Mon Dec 21 19:00:30 2015 From: petr.vapenka at gmail.com (=?UTF-8?Q?Petr_V=C3=A1penka?=) Date: Mon, 21 Dec 2015 20:00:30 +0100 Subject: [Haskell-beginners] Pattern matching is actually about matching constructors?? In-Reply-To: <56784B64.1010509@web.de> References: <56784B64.1010509@web.de> Message-ID: Hello, actually the definition with data keyword is right there: infixr 5 :-: data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) it could be written in prefix form as data List a = Empty | Cons a (List a) deriving (....) Petr On Mon, Dec 21, 2015 at 7:56 PM, Olumide <50295 at web.de> wrote: > Hello, > > On chapter 7 of LYH there's an example of a user-defined operator .++ > > infixr 5 .++ > (.++) :: List a -> List a -> List a > Empty .++ ys = ys > (x :-: xs) .++ ys = x :-: (xs .++ ys) > > which is used as follows > > let a = 3 :-: 4 :-: 5 :-: Empty > let b = 6 :-: 7 :-: Empty > a .++ b > (:-:) 3 ((:-:) 4 ((:-:) 5 ((:-:) 6 ((:-:) 7 Empty)))) > > Following this the text reads: > > "Notice how we pattern matched on (x :-: xs). That works because pattern > matching is actually about matching constructors. We can match on :-: > because it is a constructor for our own list type ..." > Source: > http://learnyouahaskell.com/making-our-own-types-and-typeclasses#recursive-data-structures > > Is the operator :-: a constructor? I'm confused because the definition of > :-: is not prefixed by the data keyword? > > - Olumide > > _______________________________________________ > 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 daniel.trstenjak at gmail.com Mon Dec 21 19:34:37 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Mon, 21 Dec 2015 20:34:37 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: References: Message-ID: <20151221193437.GA2890@octa> On Mon, Dec 21, 2015 at 06:47:54PM +0100, Imants Cekusins wrote: > if Lenses are relevant to this topic, could someone kindly post an > appropriate (Truck Parcel Can) datatype and an "unpack" with Lenses > example? For a beginner lenses might be a bit too much, because their error messages can be quite hairy, so I most likely would suggest not using them for the moment. Otherwise modifying data in a deeply nested data structure without lenses can be such a pain, so here's an example. Taking the example from Frerich and making it a bit easier usable with lenses: {-# Language TemplateHaskell #-} import Control.Lens data Can = Can deriving Show data Parcel = Parcel { _cans :: [Can] } deriving Show makeLenses ''Parcel data BoxContent = BCCan Can | BCParcel Parcel deriving Show makePrisms ''BoxContent data Box = Box { _boxContents :: [BoxContent] } deriving Show makeLenses ''Box data TruckContent = TCCan Can | TCParcel Parcel | TCBox Box deriving Show makePrisms ''TruckContent data Truck = Truck { _truckContents :: [TruckContent] } deriving Show makeLenses ''Truck By default 'makeLenses' will make lenses for every field in the record prefixed with '_', so e.g. for the field '_cans' of the record 'Parcel' a lens with the name 'cans' will be created. For ADTs like 'BoxContent' a "special" kind of lens is created - called prism - by calling 'makePrisms'. For every data constructor of 'BoxContent' - in this case 'BCCan' and 'BCParcel' - a prism with the name of the data constructor prefixed with a '_' is created: '_BCCan' and '_BCParcel'. Now put the whole above Haskell code into a file like 'Main.hs'. If you have already 'cabal' installed, then installing the 'lens' library into a sandbox and opening a repl with the 'Main.hs' file is one way of testing it: ~> cabal sandbox init ~> cabal install lens ~> cabal repl And now calling inside of the repl: :load Main.hs Creating a truck with some contents: let truck = Truck [TCBox (Box [BCCan Can])] Looking at the contents of the truck: truck ^. truckContents You can read the '^.' as applying the lens 'truckContents' on the variable 'truck'. It has the same effect as calling the field accessor '_truckContents' on 'truck'. _truckContents truck Now you can go deeper: truck ^.. truckContents . traverse . _TCBox This already involves two new things '^..' and 'traverse'. 'traverse' does visit every 'TruckContent' in 'truckContents', so it's in lens speak a traversal and because it might give multiple results you need the '^..', which collects all results into a list. The '_TCBox' works like a filter, so you're collecting all 'TCBox' of all 'TruckContent'. Try it with '_TCParcel'. Now you can go even deeper: truck ^.. truckContents . traverse . _TCBox . boxContents . traverse . _BCCan Until now you only viewed the data, but if you want to modify the data you need the operators '&', '.~' and '~%'. For e.g. to clear (setting an empty list) the 'boxContents' of every 'TCBox': truck & truckContents . traverse . _TCBox . boxContents .~ [] Or modifying the 'boxContents' by adding a 'BCCan': truck & truckContents . traverse . _TCBox . boxContents %~ (BCCan Can :) This could be also written as: truck & truckContents . traverse . _TCBox . boxContents %~ (\contents -> BCCan Can : contents) This is only the tip of the iceberg regarding lenses, but with 'makeLenses', 'makePrisms', '^.', '^..', '.~', '&' and '~%' you can already get quite far. Hopefully this was a bit helpful and not too much at once. :) These examples use the lenses from the 'lens'[1] library. Greetings, Daniel [1] https://hackage.haskell.org/package/lens From martin.drautzburg at web.de Mon Dec 21 19:41:47 2015 From: martin.drautzburg at web.de (martin) Date: Mon, 21 Dec 2015 20:41:47 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <20151221173013.GA17263@casa.casa> References: <5677C90C.3010205@web.de> <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> <56783016.4010302@web.de> <20151221173013.GA17263@casa.casa> Message-ID: <567855FB.1020202@web.de> Am 12/21/2015 um 06:30 PM schrieb Francesco Ariis: > On Mon, Dec 21, 2015 at 06:00:06PM +0100, martin wrote: >> That's fine. I'm happy not to be able to pack a truck into another truck. >> Only problem is that I don't know how to write an "unpack" function, >> which removes one level of nesting. I can only write unpackTruck, >> unpackParcel ... >> >> I suppose the ability to write a generic unpack function implies that >> there can be a generic pack function and then I could pack a truck into >> another truck. > > I would say typeclasses might help you, but before that, what would > the unpack function signature look like? > > unpack :: (Package s) => s a -> [a] > > Like this? If so, I don't see much benefit (or what problem we're > trying to solve) in trucks>boxes>parcels>cans types. Unpacking should separate the container from its contents, i.e. given a packed container it should return an empty container and whatever was inside. From imantc at gmail.com Mon Dec 21 20:06:55 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 21:06:55 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <20151221193437.GA2890@octa> References: <20151221193437.GA2890@octa> Message-ID: > a lens with the name 'cans' will be created. Does Template Haskell modify code file or can these '_' names be used throughout the code without visible definition? Thank you for this very detailed and specific example. Could we say that lens is a bit like extension to record syntax: allow to traverse, get and set properties for structures that are more complex than simple 1 level record? Why do lens require Template Haskell? Only to generate '_' functions? -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Mon Dec 21 20:10:42 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 21 Dec 2015 21:10:42 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <567855FB.1020202@web.de> References: <5677C90C.3010205@web.de> <6aa85b75b275eec48cecef90febdabc9@roundcube.froglogic.com> <56783016.4010302@web.de> <20151221173013.GA17263@casa.casa> <567855FB.1020202@web.de> Message-ID: <20151221201042.GA20747@casa.casa> On Mon, Dec 21, 2015 at 08:41:47PM +0100, martin wrote: > > I would say typeclasses might help you, but before that, what would > > the unpack function signature look like? > > > > unpack :: (Package s) => s a -> [a] > > > > Like this? If so, I don't see much benefit (or what problem we're > > trying to solve) in trucks>boxes>parcels>cans types. > > Unpacking should separate the container from its contents, i.e. > given a packed container it should return an empty container and > whatever was inside. I'd still ask for a type signature if you feel it's possible, it clears things up (and/or highlights where the type system is getting in the way). An I'd still argue that "arbitrarily nestable" things is a bad idea, as Kim-Ee Yeoh explained. I like Haskell type system because carefully designed types "lead the way": some 'wrong' code won't even compile. In real life, what are we trying to model? Why is `unpack` useful/needed? How would I use its output? (a valid answer being: "just a mental experiment") From imantc at gmail.com Mon Dec 21 20:56:04 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 21:56:04 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <20151221193437.GA2890@octa> References: <20151221193437.GA2890@octa> Message-ID: > makeLenses ''Parcel any cues re: what '' stand for in the above expression? From daniel.trstenjak at gmail.com Mon Dec 21 21:17:21 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Mon, 21 Dec 2015 22:17:21 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: References: <20151221193437.GA2890@octa> Message-ID: <20151221211721.GB2890@octa> On Mon, Dec 21, 2015 at 09:06:55PM +0100, Imants Cekusins wrote: > > a lens with the name 'cans' will be created. > > Does Template Haskell modify code file or can these '_' names be used > throughout the code without visible definition? In this case Template Haskell doesn't modify the code, fields like '_cans' are just normal fields and can be used with this name. There's only the convention that 'makeLenses' creates for every field with a '_' prefix a lens. In the case of '_cans' a lens like this will be created: cans :: Lens' Parcel [Can] cans = lens getCans setCans where getCans parcel = _cans parcel setCans parcel cans = parcel { _cans = cans } (This is just an idealized implementation and the real one will be most likely a bit more sophisticated and optimized.) > Could we say that lens is a bit like extension to record syntax: allow to > traverse, get and set properties for structures that are? more complex than > simple 1 level record? It's often compared with some kind of jQuery for data structures. > Why do lens require Template Haskell? Only to generate '_' functions? To automatically generate the Haskell code like the lens 'cans' in the above example. Greetings, Daniel From daniel.trstenjak at gmail.com Mon Dec 21 21:22:44 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Mon, 21 Dec 2015 22:22:44 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: References: <20151221193437.GA2890@octa> Message-ID: <20151221212244.GA3355@octa> On Mon, Dec 21, 2015 at 09:56:04PM +0100, Imants Cekusins wrote: > > makeLenses ''Parcel > > any cues re: what '' stand for in the above expression? It's just the escaping of the name needed for Template Haskell. I think it's the same like calling: makeLenses "Parcel" From imantc at gmail.com Mon Dec 21 21:41:34 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 21 Dec 2015 22:41:34 +0100 Subject: [Haskell-beginners] How to nest arbitrary things In-Reply-To: <20151221212244.GA3355@octa> References: <20151221193437.GA2890@octa> <20151221212244.GA3355@octa> Message-ID: Thank you very much Daniel. Lens is a lot clearer now. jQuery eh? $(truckContents . _TCBox) ;) From ky3 at atamo.com Tue Dec 22 05:08:22 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 22 Dec 2015 12:08:22 +0700 Subject: [Haskell-beginners] Pattern matching is actually about matching constructors?? In-Reply-To: <56784B64.1010509@web.de> References: <56784B64.1010509@web.de> Message-ID: On Tue, Dec 22, 2015 at 1:56 AM, Olumide <50295 at web.de> wrote: > Is the operator :-: a constructor? I'm confused because the definition of > :-: is not prefixed by the data keyword? The confusion is that the pattern-matching for append, i.e. (.++), is done infix style: Empty .++ ys = ys (x :-: xs) .++ ys = x :-: (xs .++ ys) This defines (.++). It doesn't define (:-:). The definition of (.++) pattern matches on (:-:) in (.++)-infix style to do the job. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Tue Dec 22 05:29:32 2015 From: martin.drautzburg at web.de (martin) Date: Tue, 22 Dec 2015 06:29:32 +0100 Subject: [Haskell-beginners] Mixing pattern matching and guards Message-ID: <5678DFBC.2050605@web.de> Hello all, I recently wrote this piece of code import qualified Data.Set as S [...] purge :: (Eq cp, Eq ip) => Product cp ip -> Product cp ip purge (Punion ps) | ps' == S.empty = Pempty where ps' = S.filter (/= Pempty) ps purge x = x and I thought I had missed the "otherwise" case in the guard and I was prepared to see a "non exhaustive ..." error, but to my amazement it works *Main> purge $ Punion $ S.fromList [Packed 1 Pempty] Punion (fromList [Packed 1 Pempty]) As this is a Punion, it should match the first pattern, but not the guard. It seems to fall right through to the second pattern. Is this the way it works? From fa-ml at ariis.it Tue Dec 22 06:16:14 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 22 Dec 2015 07:16:14 +0100 Subject: [Haskell-beginners] Mixing pattern matching and guards In-Reply-To: <5678DFBC.2050605@web.de> References: <5678DFBC.2050605@web.de> Message-ID: <20151222061614.GA1361@casa.casa> On Tue, Dec 22, 2015 at 06:29:32AM +0100, martin wrote: > Hello all, > > I recently wrote this piece of code > > import qualified Data.Set as S > [...] > purge :: (Eq cp, Eq ip) => Product cp ip -> Product cp ip > purge (Punion ps) > | ps' == S.empty = Pempty > where ps' = S.filter (/= Pempty) ps > purge x = x > > > and I thought I had missed the "otherwise" case in the guard and I was > prepared to see a "non exhaustive ..." error, but > to my amazement it works The pattern does match (and any variable bound by it is made available to the corresponding guards). Then guards are tried in order: if no guard succeed, the next pattern match is found (in your case purge x = x, irrefutable). If you want you can add a catch all guard as last guard: | ps' == S.empty = Pempty | otherwise = undefined -- handle ps' /= S.empty here From 50295 at web.de Tue Dec 22 10:53:51 2015 From: 50295 at web.de (Olumide) Date: Tue, 22 Dec 2015 10:53:51 +0000 Subject: [Haskell-beginners] Pattern matching is actually about matching constructors?? In-Reply-To: References: <56784B64.1010509@web.de> Message-ID: <56792BBF.3040700@web.de> Petr, Of course you are right. :-: is a value constructor (function) albeit declared in the infix style a :-: (List a). Thanks, - Olumide On 21/12/15 19:00, Petr V?penka wrote: > Hello, > > actually the definition with data keyword is right there: > > infixr 5 :-: > data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) > > it could be written in prefix form as > > data List a = Empty | Cons a (List a) deriving (....) > > > Petr > > > > > On Mon, Dec 21, 2015 at 7:56 PM, Olumide <50295 at web.de > > wrote: > > Hello, > > On chapter 7 of LYH there's an example of a user-defined operator .++ > > infixr 5 .++ > (.++) :: List a -> List a -> List a > Empty .++ ys = ys > (x :-: xs) .++ ys = x :-: (xs .++ ys) > > which is used as follows > > let a = 3 :-: 4 :-: 5 :-: Empty > let b = 6 :-: 7 :-: Empty > a .++ b > (:-:) 3 ((:-:) 4 ((:-:) 5 ((:-:) 6 ((:-:) 7 Empty)))) > > Following this the text reads: > > "Notice how we pattern matched on (x :-: xs). That works because > pattern matching is actually about matching constructors. We can > match on :-: because it is a constructor for our own list type ..." > Source: > http://learnyouahaskell.com/making-our-own-types-and-typeclasses#recursive-data-structures > > Is the operator :-: a constructor? I'm confused because the > definition of :-: is not prefixed by the data keyword? > > - Olumide > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > From rustompmody at gmail.com Tue Dec 22 12:48:57 2015 From: rustompmody at gmail.com (Rustom Mody) Date: Tue, 22 Dec 2015 18:18:57 +0530 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: On Mon, Dec 21, 2015 at 4:57 AM, Darren Grant wrote: > On Dec 20, 2015 08:39, "Rustom Mody" wrote: > >> >> >> On Wed, Dec 16, 2015 at 1:43 AM, Rein Henrichs >> wrote: >> >>> >>> Mr. McIlroy, >>> >>> FWIW I would love to read more about that McCarthy talk. It >>> sounds like an amazing experience. >>> >>> >> No I was not there (in more than one sense!) when that talk happened >> >> About the power of scheme being under-appreciated (even by the authors of >> SICP!) >> >> http://blog.languager.org/2013/08/applying-si-on-sicp.html >> >> >> >> Lacking intentional syntax for function application is much more profound > than I would have expected. > Not sure what you mean: Scheme does not have intentional syntax for function application. Neither does Haskell. Both have a reified (or first-classed) function for function-application. Scheme pronounces it 'apply'. Haskell pronounces it '$' This is close but not quite the same as an explicit application syntax: Close because if we have foo x = 2*x we can write Prelude> foo $ (2+5) 14 or Prelude> foo (2+5) 14 Not quite the same because the definition of foo cannot be 'explicitized' to foo$x = 2*x -------------- next part -------------- An HTML attachment was scrubbed... URL: From dedgrant at gmail.com Tue Dec 22 22:04:13 2015 From: dedgrant at gmail.com (Darren Grant) Date: Tue, 22 Dec 2015 14:04:13 -0800 Subject: [Haskell-beginners] Doubts about functional programming paradigm In-Reply-To: References: <201512151132.tBFBWQOg025373@coolidge.cs.Dartmouth.EDU> Message-ID: Much better said. :) Put my foot in my mouth. I was vaguely accusative where I intended to allude to comprehension. There are certain basic connections that had not really ever gelled prior to reading some of your posts. For example, that function application itself is obviously a fixed point had me slapping my forehead. Much taken for granted in my day to day work. Cheers, Darren On Dec 22, 2015 4:49 AM, "Rustom Mody" wrote: > On Mon, Dec 21, 2015 at 4:57 AM, Darren Grant wrote: > >> On Dec 20, 2015 08:39, "Rustom Mody" wrote: >> >>> >>> >>> On Wed, Dec 16, 2015 at 1:43 AM, Rein Henrichs >>> wrote: >>> >>>> >>>> Mr. McIlroy, >>>> >>>> FWIW I would love to read more about that McCarthy talk. It >>>> sounds like an amazing experience. >>>> >>>> >>> No I was not there (in more than one sense!) when that talk happened >>> >>> About the power of scheme being under-appreciated (even by the authors >>> of SICP!) >>> >>> http://blog.languager.org/2013/08/applying-si-on-sicp.html >>> >>> >>> >>> Lacking intentional syntax for function application is much more >> profound than I would have expected. >> > > Not sure what you mean: Scheme does not have intentional syntax for > function application. > Neither does Haskell. > Both have a reified (or first-classed) function for function-application. > Scheme pronounces it 'apply'. Haskell pronounces it '$' > > This is close but not quite the same as an explicit application syntax: > > Close because if we have > foo x = 2*x > > we can write > > Prelude> foo $ (2+5) > 14 > > or > > Prelude> foo (2+5) > 14 > > Not quite the same because the definition of foo cannot be 'explicitized' > to > > foo$x = 2*x > > _______________________________________________ > 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 martin.drautzburg at web.de Wed Dec 23 12:55:26 2015 From: martin.drautzburg at web.de (martin) Date: Wed, 23 Dec 2015 13:55:26 +0100 Subject: [Haskell-beginners] How to show a predicate Message-ID: <567A99BE.7080900@web.de> Hello all, in my program, I do stuff with predicates (a->Bool). For the most part this representation is just fine, but at the very end I need to convert a resulting predicate into a String so I can write it to a file. Wenn I represent my predicates as Lists or Sets, then this is doable and I am tempted to do it this way. The only other option I could come up with was to have a representation of "everything", which would in my case be large (10^8) but finite. Then I could construct a List or a Set at the very end, as [x | x<-everything, p x] without having explicit sets in the intermediate steps. I cannot see any other option, but I thought I better ask. From martin.drautzburg at web.de Wed Dec 23 13:00:47 2015 From: martin.drautzburg at web.de (martin) Date: Wed, 23 Dec 2015 14:00:47 +0100 Subject: [Haskell-beginners] explaining effects In-Reply-To: <566FD590.70607@plaimi.net> References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> Message-ID: <567A9AFF.60702@web.de> Am 12/15/2015 um 09:55 AM schrieb Alexander Berntsen: > FWIW, I say "effect" rather than "side effect" when talking about Haskell, because in Haskell effects happen when > you want them, not as an unforeseen side-effect as a result of the complexity inherent to the source code. > > It is often said that having an effect is "difficult" in Haskell. But really, it's just that if you are launching > missiles in Haskell, *you actually mean to*. It didn't happen because you wanted to increment i and then "oops, > stuff happened". What is the exact defintion of "effect". Everybody talks about it but I am certainly unable to give a defintion. From imantc at gmail.com Wed Dec 23 13:46:09 2015 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 23 Dec 2015 14:46:09 +0100 Subject: [Haskell-beginners] explaining effects In-Reply-To: <567A9AFF.60702@web.de> References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: > What is the exact defintion of "effect". let's try: effect: A change which is a consequence of an action (in this case, function call) side effect: change of environment state which is a consequence of an action (function call) pure function: calling this function does not affect environment state function returns a value, that's all I am not sure if function running inside e.g. state monad and modifying this monad's state is pure, i.e. if state monad is environment From maydwell at gmail.com Fri Dec 25 14:11:16 2015 From: maydwell at gmail.com (Lyndon Maydwell) Date: Fri, 25 Dec 2015 22:11:16 +0800 Subject: [Haskell-beginners] How to show a predicate In-Reply-To: <567A99BE.7080900@web.de> References: <567A99BE.7080900@web.de> Message-ID: Depending on how you construct your predicates, you may be able to capture their composition... And then serialise that. For example: If you were doing some sort of range intersection predicate construction ~ R1 n R2 n R3 Could be represented as a list of those ranges [(l1,r1),(l2,r2),(l3,r3)]. Basically, instead of constructing a predicate function directly, you would assemble a data-structure representing the essence of the predicate, then convert that to both a function for evaluation, as well as a string for serialisation. This would also allow you to perform some "optimisation" before serialisation which could be fun. Do you have some examples of what the predicates look like? - Lyndon On Wed, Dec 23, 2015 at 8:55 PM, martin wrote: > Hello all, > > in my program, I do stuff with predicates (a->Bool). For the most part > this representation is just fine, but at the very > end I need to convert a resulting predicate into a String so I can write > it to a file. > > Wenn I represent my predicates as Lists or Sets, then this is doable and I > am tempted to do it this way. The only other > option I could come up with was to have a representation of "everything", > which would in my case be large (10^8) but > finite. Then I could construct a List or a Set at the very end, as [x | > x<-everything, p x] without having explicit sets > in the intermediate steps. > > I cannot see any other option, but I thought I better ask. > _______________________________________________ > 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 abhisandhyasp.ap at gmail.com Fri Dec 25 18:32:19 2015 From: abhisandhyasp.ap at gmail.com (Abhijit Patel) Date: Sat, 26 Dec 2015 00:02:19 +0530 Subject: [Haskell-beginners] warning in making instances of Functor class! Message-ID: why am i getting warning in the following code?? though it works perfectly!!! Prelude> newtype Pair1 c b a=Pair1 {getPair1 :: (a,b,c)} Prelude> :{ Prelude| instance Functor (Pair1 m n) where Prelude| fmap f (Pair1 (x,y,z))=Pair1 (f x,y,z) Prelude| :} :55:10: Warning: No explicit implementation for ?Prelude.fmap? In the instance declaration for ?Functor (Pair1 m n)? -- The below shows it is working fine! Prelude> getPair1 $ fmap (*100) (Pair1 (2,3,1)) (200,3,1) -------------- next part -------------- An HTML attachment was scrubbed... URL: From pmcilroy at gmail.com Fri Dec 25 19:13:33 2015 From: pmcilroy at gmail.com (pmcilroy at gmail.com) Date: Fri, 25 Dec 2015 11:13:33 -0800 Subject: [Haskell-beginners] FW: Initial startup of GHCi (Windows) v. 7.10.3 In-Reply-To: <567d94fb.8f0e620a.87e0b.ffffeac4@mx.google.com> References: <567d94fb.8f0e620a.87e0b.ffffeac4@mx.google.com> Message-ID: <567d955e.dd49620a.53619.ffffed7d@mx.google.com> Running on windows 10, GHC interactive fails to load any standard packages. The startup? message does not include the prompt about initializing packages do, as shown commonly on Haskell getting started tutorials. Instead I see: GHCi, version 7.10.3: http://www.haskell.org/ghc/? :? for help Prelude> :l Data.Text : module ?Data.Text? is a package module Failed, modules loaded: none. Prelude> Any pointers on what to do next? -------------- next part -------------- An HTML attachment was scrubbed... URL: From stephen.tetley at gmail.com Fri Dec 25 19:51:11 2015 From: stephen.tetley at gmail.com (Stephen Tetley) Date: Fri, 25 Dec 2015 19:51:11 +0000 Subject: [Haskell-beginners] FW: Initial startup of GHCi (Windows) v. 7.10.3 In-Reply-To: <567d955e.dd49620a.53619.ffffed7d@mx.google.com> References: <567d94fb.8f0e620a.87e0b.ffffeac4@mx.google.com> <567d955e.dd49620a.53619.ffffed7d@mx.google.com> Message-ID: You need to use :m (or :module) to load (preinstalled) modules rather than files, e.g: Prelude> :m Data.Text Prelude Data.Text> Best wishes On 25 December 2015 at 19:13, wrote: > > > Running on windows 10, GHC interactive fails to load any standard packages. > The startup message does not include the prompt about initializing packages > do, as shown commonly on Haskell getting started tutorials. Instead I see: > > > > GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help > > Prelude> :l Data.Text > > > > : module ?Data.Text? is a package module > > Failed, modules loaded: none. > > Prelude> > > > > Any pointers on what to do next? > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From imantc at gmail.com Fri Dec 25 19:56:17 2015 From: imantc at gmail.com (Imants Cekusins) Date: Fri, 25 Dec 2015 20:56:17 +0100 Subject: [Haskell-beginners] warning in making instances of Functor class! In-Reply-To: References: Message-ID: Hello Abhijit a properly formatted statement as you intended it is: instance Functor (Pair1 m n) where fmap f (Pair1 (x,y,z))=Pair1 (f x,y,z) note the indent before fmap. without the tab, fmap f (Pair1 (x,y,z))=Pair1 (f x,y,z) is just a stand alone function delcaration if you enter instance.. line #1 but not the fmap line #2, you will see the same warning you are seeing. if you enter #2 but not #1, this line: getPair1 $ fmap (*100) (Pair1 (2,3,1)) will work fine too. basically, flush (no indent) line begins a new code block From rein.henrichs at gmail.com Sat Dec 26 02:19:21 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sat, 26 Dec 2015 02:19:21 +0000 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: There is no exact definition of "effect" so this discussion must necessarily be vague and probably not very enlightening. The State Monad may or may not have effects, depending on your definition, but it is definitely pure. On Wed, Dec 23, 2015 at 5:46 AM Imants Cekusins wrote: > > What is the exact defintion of "effect". > > let's try: > > effect: > A change which is a consequence of an action (in this case, function call) > > side effect: > change of environment state which is a consequence of an action (function > call) > > pure function: > calling this function does not affect environment state > function returns a value, that's all > > I am not sure if function running inside e.g. state monad and > modifying this monad's state is pure, i.e. if state monad is > environment > _______________________________________________ > 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 cma at bitemyapp.com Sat Dec 26 02:56:14 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Fri, 25 Dec 2015 20:56:14 -0600 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: Incidentally, IO is pure too On Fri, Dec 25, 2015 at 8:19 PM, Rein Henrichs wrote: > There is no exact definition of "effect" so this discussion must > necessarily be vague and probably not very enlightening. The State Monad > may or may not have effects, depending on your definition, but it is > definitely pure. > > On Wed, Dec 23, 2015 at 5:46 AM Imants Cekusins wrote: > >> > What is the exact defintion of "effect". >> >> let's try: >> >> effect: >> A change which is a consequence of an action (in this case, function call) >> >> side effect: >> change of environment state which is a consequence of an action (function >> call) >> >> pure function: >> calling this function does not affect environment state >> function returns a value, that's all >> >> I am not sure if function running inside e.g. state monad and >> modifying this monad's state is pure, i.e. if state monad is >> environment >> _______________________________________________ >> 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 > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sat Dec 26 12:09:13 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 26 Dec 2015 13:09:13 +0100 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: for some practical purposes, would it make sense to forget about effects and purity and distinguish only between IO and non-IO? It should be easy enough to tell IO from non-IO, no? also, could we say that a function that returns a value of such a type of which no part is a function (for lack of a better definition) is definitely a pure function ? From theedge456 at free.fr Sat Dec 26 14:19:17 2015 From: theedge456 at free.fr (Fabien R) Date: Sat, 26 Dec 2015 15:19:17 +0100 Subject: [Haskell-beginners] find an element in a list Message-ID: <567EA1E5.2040604@free.fr> As a newbie, I'm studying the pdf 'the Haskell road to logic, math and programming' and I'm stuck with one exercise. I want to extract x if x is at the beginning of a list. I thought to use something like this: extractIfBegins x [xs] | [xs] == (x:ys) = [ys] | otherwise = [xs] But ghci complains that ys is not defined. Without giving the answer, can someone give a hint about the approach to follow ? -- Fabien From max.voit+mlhb at with-eyes.net Sat Dec 26 14:46:19 2015 From: max.voit+mlhb at with-eyes.net (Max Voit) Date: Sat, 26 Dec 2015 15:46:19 +0100 Subject: [Haskell-beginners] find an element in a list In-Reply-To: <567EA1E5.2040604@free.fr> References: <567EA1E5.2040604@free.fr> Message-ID: <20151226154619.72b077cd@veeloqu.lan> Hi Fabien, On Sat, 26 Dec 2015 15:19:17 +0100 Fabien R wrote: > extractIfBegins x [xs] | [xs] == (x:ys) = [ys] > | otherwise = [xs] > > But ghci complains that ys is not defined. That is because you cannot pattern match whilst equality testing. The statement xs == (x:ys) is problematic therefore. You expect the compiler to see "oh, I don't know ys, but xs is a list, so I'm just checking x and put the rest into ys while I'm at it". > Without giving the answer, can someone give a hint about the approach > to follow ? Try pattern matching on the list xs instead. Also take care that it's xs, not [xs] (the latter notation implies a list with one element xs). Best, Max From toad3k at gmail.com Sat Dec 26 14:59:26 2015 From: toad3k at gmail.com (David McBride) Date: Sat, 26 Dec 2015 09:59:26 -0500 Subject: [Haskell-beginners] find an element in a list In-Reply-To: <567EA1E5.2040604@free.fr> References: <567EA1E5.2040604@free.fr> Message-ID: It sounds like you want to include x only if it is not already at the head of the list. Try this: extractIfBegins x (y:ys) | x == y = ys | otherwise = x:ys On Sat, Dec 26, 2015 at 9:19 AM, Fabien R wrote: > As a newbie, I'm studying the pdf 'the Haskell road to logic, math and > programming' and I'm stuck with one exercise. > I want to extract x if x is at the beginning of a list. > I thought to use something like this: > extractIfBegins x [xs] | [xs] == (x:ys) = [ys] | > otherwise = [xs] > > But ghci complains that ys is not defined. > Without giving the answer, can someone give a hint about the approach to > follow ? > > -- > Fabien > _______________________________________________ > 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 theedge456 at free.fr Sat Dec 26 15:39:25 2015 From: theedge456 at free.fr (Fabien R) Date: Sat, 26 Dec 2015 16:39:25 +0100 Subject: [Haskell-beginners] find an element in a list In-Reply-To: <20151226154619.72b077cd@veeloqu.lan> References: <567EA1E5.2040604@free.fr> <20151226154619.72b077cd@veeloqu.lan> Message-ID: <567EB4AD.9080107@free.fr> On 26/12/15 15:46, Max Voit wrote: > That is because you cannot pattern match whilst equality testing. The > statement > xs == (x:ys) > is problematic therefore. You expect the compiler to see "oh, I don't > know ys, but xs is a list, so I'm just checking x and put the rest into > ys while I'm at it". Thanks Max, It's more clear now. -- Fabien From martin.drautzburg at web.de Sat Dec 26 17:44:40 2015 From: martin.drautzburg at web.de (martin) Date: Sat, 26 Dec 2015 18:44:40 +0100 Subject: [Haskell-beginners] How to show a predicate In-Reply-To: References: <567A99BE.7080900@web.de> Message-ID: <567ED208.7010409@web.de> Am 12/25/2015 um 03:11 PM schrieb Lyndon Maydwell: > Depending on how you construct your predicates, you may be able to capture their composition... And then serialise that. > > For example: > > If you were doing some sort of range intersection predicate construction ~ > > R1 n R2 n R3 > > Could be represented as a list of those ranges [(l1,r1),(l2,r2),(l3,r3)]. Basically, instead of constructing a predicate > function directly, you would assemble a data-structure representing the essence of the predicate, then convert that to > both a function for evaluation, as well as a string for serialisation. This would also allow you to perform some > "optimisation" before serialisation which could be fun. Thanks, I understand I need a representation and a Set would be just one of the possiblilities. From rein.henrichs at gmail.com Sat Dec 26 18:53:20 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sat, 26 Dec 2015 18:53:20 +0000 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: TL;DR: Evaluation is always pure[1]. Execution isn't, but it wasn't supposed to be in the first place. > would it make sense to forget about effects and purity and distinguish only between IO and non-IO? It should be easy enough to tell IO from non-IO, no? There is no need to distinguish between IO and non-IO. Everything is pure, including IO. When people talk about effects, they tend to mean something encapsulated and "hidden" by the implementation of bind and return for a particular Monad instance; the meaning of "effect" is entirely dependent on this context. For example, State encapsulates the effect of passing an accumulating parameter to multiple functions and properly threading the results. Reader encapsulates additional function parameters that are never varied. Writer encapsulates writing to a "log" (any monoidal accumulator). The list monad encapsulates the effect of non-determinism (functions that can return more than one result), allowing you to work with placeholder variables that represent all possible results at that stage of the computation. ST encapsulates mutation in way that is *externally unobservable*. And so on. None of these "effects" are impure. They are all referentially transparent. They do not mutate any external or global state. They can all be rewritten by inlining the relevant definitions of bind and return in a way that will make it obvious that no "funny stuff" is happening. One important difference between this sort of encapsulation and the kind that you might find in an OOP language is that this encapsulation is *perfect*. These abstractions *do not leak*. There is no way for your program to externally observe any mutation during evaluation of a State action and the same holds, mutatis mutandis, for all the other monad instances. IO is a common source of confusion, but the important distinction here is the one that Chris already made: *evaluation* of IO actions is pure, referentially transparent, and causes no effects (side- or otherwise). Execution of the `main` IO action by the runtime?and by extension the execution of those other IO actions that may compose it?is obviously not pure, but no one is expecting *execution* to be pure: if execution were required to be pure then the program couldn't be run at all, because any attempt to run it would cause some sort of externally observable effect (even if it merely heats up the surrounding space a bit). A commonly used metaphor that may help to understand this is to consider an IO action to be like a recipe like one might find in a cookbook. If `getLine` is the recipe for a particular type of cake then it will be the same recipe every time it is invoked. The actual cake that you produce when you execute the recipe may differ?more or less, depending on how proficient you are at baking?but this does not mean that the recipe itself has changed each time. And so it is with IO: The actions are pure. They are the same every time. The results that they produce when executed may change, but this is not at odds with our claim that the values themselves are pure. > also, could we say that a function that returns a value of such a type of which no part is a function (for lack of a better definition) is definitely a pure function Yes, and all the other functions are pure too. [1] Modulo usages of `unsafePerformIO` and friends, but these can and should be dealt with separately. On Sat, Dec 26, 2015 at 4:09 AM Imants Cekusins wrote: > for some practical purposes, would it make sense to forget about > effects and purity and distinguish only between IO and non-IO? It > should be easy enough to tell IO from non-IO, no? > > also, could we say that a function that returns a value of such a type > of which no part is a function (for lack of a better definition) is > definitely a pure function > > ? > _______________________________________________ > 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 rein.henrichs at gmail.com Sat Dec 26 18:59:58 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sat, 26 Dec 2015 18:59:58 +0000 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: > They can all be rewritten by inlining the relevant definitions of bind and return in a way that will make it obvious that no "funny stuff" is happening. This is actually a bit suspect for ST, since it involves uses of the unsafe functions mentioned in my footnote. The argument is that these functions are being used in a provably safe way, but the proof cannot be executed in Haskell: it must be executed elsewhere and ported into Haskell, but it is still valid (unless the implementation is incorrect). This is an exemplary usage of unsafe functions to provide *safe* features where the implementor has satisfied this proof of safety obligation elsewhere and doesn't require Haskell's type system to prove it for them; and where they otherwise wouldn't able to provide this functionality or this performance optimization or etc. On Sat, Dec 26, 2015 at 10:53 AM Rein Henrichs wrote: > TL;DR: Evaluation is always pure[1]. Execution isn't, but it wasn't > supposed to be in the first place. > > > would it make sense to forget about effects and purity and distinguish > only between IO and non-IO? It should be easy enough to tell IO from > non-IO, no? > > There is no need to distinguish between IO and non-IO. Everything is pure, > including IO. > > When people talk about effects, they tend to mean something encapsulated > and "hidden" by the implementation of bind and return for a particular > Monad instance; the meaning of "effect" is entirely dependent on this > context. For example, State encapsulates the effect of passing an > accumulating parameter to multiple functions and properly threading the > results. Reader encapsulates additional function parameters that are never > varied. Writer encapsulates writing to a "log" (any monoidal accumulator). > The list monad encapsulates the effect of non-determinism (functions that > can return more than one result), allowing you to work with placeholder > variables that represent all possible results at that stage of the > computation. ST encapsulates mutation in way that is *externally > unobservable*. And so on. None of these "effects" are impure. They are all > referentially transparent. They do not mutate any external or global state. > They can all be rewritten by inlining the relevant definitions of bind and > return in a way that will make it obvious that no "funny stuff" is > happening. > > One important difference between this sort of encapsulation and the kind > that you might find in an OOP language is that this encapsulation is > *perfect*. These abstractions *do not leak*. There is no way for your > program to externally observe any mutation during evaluation of a State > action and the same holds, mutatis mutandis, for all the other monad > instances. > > IO is a common source of confusion, but the important distinction here is > the one that Chris already made: *evaluation* of IO actions is pure, > referentially transparent, and causes no effects (side- or otherwise). > Execution of the `main` IO action by the runtime?and by extension the > execution of those other IO actions that may compose it?is obviously not > pure, but no one is expecting *execution* to be pure: if execution were > required to be pure then the program couldn't be run at all, because any > attempt to run it would cause some sort of externally observable effect > (even if it merely heats up the surrounding space a bit). > > A commonly used metaphor that may help to understand this is to consider > an IO action to be like a recipe like one might find in a cookbook. If > `getLine` is the recipe for a particular type of cake then it will be the > same recipe every time it is invoked. The actual cake that you produce when > you execute the recipe may differ?more or less, depending on how proficient > you are at baking?but this does not mean that the recipe itself has changed > each time. And so it is with IO: The actions are pure. They are the same > every time. The results that they produce when executed may change, but > this is not at odds with our claim that the values themselves are pure. > > > also, could we say that a function that returns a value of such a > type of which no part is a function (for lack of a better definition) > is definitely a pure function > > Yes, and all the other functions are pure too. > > [1] Modulo usages of `unsafePerformIO` and friends, but these can and > should be dealt with separately. > > On Sat, Dec 26, 2015 at 4:09 AM Imants Cekusins wrote: > >> for some practical purposes, would it make sense to forget about >> effects and purity and distinguish only between IO and non-IO? It >> should be easy enough to tell IO from non-IO, no? >> >> also, could we say that a function that returns a value of such a type >> of which no part is a function (for lack of a better definition) is >> definitely a pure function >> >> ? >> _______________________________________________ >> 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 k-bx at k-bx.com Tue Dec 29 07:21:52 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Tue, 29 Dec 2015 09:21:52 +0200 Subject: [Haskell-beginners] How to show a predicate In-Reply-To: <567A99BE.7080900@web.de> References: <567A99BE.7080900@web.de> Message-ID: You can store both values, a function and a string representation, in a predicate: data Predicate = Predicate (a -> Bool) String And write corresponding Show instance to show string. On Wed, Dec 23, 2015 at 2:55 PM, martin wrote: > Hello all, > > in my program, I do stuff with predicates (a->Bool). For the most part > this representation is just fine, but at the very > end I need to convert a resulting predicate into a String so I can write > it to a file. > > Wenn I represent my predicates as Lists or Sets, then this is doable and I > am tempted to do it this way. The only other > option I could come up with was to have a representation of "everything", > which would in my case be large (10^8) but > finite. Then I could construct a List or a Set at the very end, as [x | > x<-everything, p x] without having explicit sets > in the intermediate steps. > > I cannot see any other option, but I thought I better ask. > _______________________________________________ > 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 alexander at plaimi.net Tue Dec 29 11:00:50 2015 From: alexander at plaimi.net (Alexander Berntsen) Date: Tue, 29 Dec 2015 12:00:50 +0100 Subject: [Haskell-beginners] explaining effects In-Reply-To: References: <871taraisb.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> <566FD590.70607@plaimi.net> <567A9AFF.60702@web.de> Message-ID: <568267E2.8050301@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 Rein explains effects well enough. Now for side-effects: a side-effect is what is allowed to happen in the absence of a weak equivalence between call-by-name (including memoised versions) and call-by-value[0]. Let's play "spot the side-effect!" - -- Haskell function for adding two numbers. f x y = x + y - -- function in a language that happens to be syntactically like Haskell. f x y = print "Hallo!" >> x + y - -- program to evaluate the function. - -- it just happens to be equal in Haskell and the Haskell-like language. main = let a = f 4 2 in print a >> print a evaluation-strategy | call-by-need | call-by-value - ------------------------------------------------------------- x + y | 6\n6 | 6\n6 print "Hallo" >> x + y | Hallo!\n6\n6 | Hallo!\n6\nHallo!\n6 See how the latter function differs in call-by-need and call-by-value? This is because it has a *side-effect* of printing stuff. This is not allowed in Haskell. And in fact, the latter function is impossible in Haskell. As Rein was getting at by abstraction leaks -- side-effects have an observable interaction with the outside world. [0] - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWgmfhAAoJENQqWdRUGk8BZfkQAOft2e7RmRheu0ZGAXXj3P4m 4zPnJ5SQ//+TTM2rzH1b6ifoidGgEhKiyDr2IajXbj0wIbPLXqORByXUFx6E6I1q rz9rslEb2XGwxTOm/Wi90IGO6niEPO1+/WCFCLE2G+Fh2M3uo381djlQfaS1MVla 1UtzElnX2bnpLfjeSjMFFB2joEuCCl8Gz+QXVGIX1H3BE+xSyM+vllDtkwob/6Bn OyPckgGyiQlt5RpPoBsdEBU5qzrT5yJWaRWeiRIg293XrOPls3kM0GvhvaAFXmWr 1A/L391BQtw65xeGTlPArCi+xemwVsgwK2hdQWPmTrpJATveV0vN1OhQMkiI5b+Q 5SfKo0MKKWezRu7avIfaJ0IUB5Pl/FM+IhMFoHWM4oE5ixh7Vr91nslhOMjvAWgR GzKyMuY63CLoy/1He5nNoCJ2Pjwdf65lUOD/sNJhjLbd2qw220UFE4L2SOLXLX5U uBY1GF3C+biH2ai7utKU9RBXyV7p5dVcV4vft+Eb118QJmp3fFP26HS6IwuD3V8q JNWAo7ZTK5vpujUHtee2J1ltHrleSlVaaJE0ONDzKDzi7QrwUAUbae3/Wnzy5zBF ZXSPqABh8MNjkItax5zQwHyvgcJTRNtt7xj41+d7WKscgy5XvDQC3/RSQPXYZ9Ib upR6CDDSP2bns7KfRDU0 =AGvd -----END PGP SIGNATURE----- From 50295 at web.de Thu Dec 31 12:52:44 2015 From: 50295 at web.de (Olumide) Date: Thu, 31 Dec 2015 12:52:44 +0000 Subject: [Haskell-beginners] Why must inflix constructors begin with a colon? Message-ID: <5685251C.9000205@web.de> I'm new to Haskell and wondering why this restriction? For example (from LYH): infixr 5 :-: data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) Thanks, - Olumide From 50295 at web.de Thu Dec 31 13:06:18 2015 From: 50295 at web.de (Olumide) Date: Thu, 31 Dec 2015 13:06:18 +0000 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class Message-ID: <5685284A.3010702@web.de> According to LYH, the list is an instance of the Functor type class: instance Functor [] where fmap = map Why does 'f' not appear in this expression?, considering that Functor is defined as class Functor f where fmap :: (a -> b) -> f a -> f b Overall, I'm a bit confused about the relationship between the type constructor f and []. Thanks, - Olumide From alexander at plaimi.net Thu Dec 31 13:10:18 2015 From: alexander at plaimi.net (Alexander Berntsen) Date: Thu, 31 Dec 2015 14:10:18 +0100 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5685284A.3010702@web.de> References: <5685284A.3010702@web.de> Message-ID: <5685293A.7020104@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 On 31/12/15 14:06, Olumide wrote: > Overall, I'm a bit confused about the relationship between the type > constructor f and []. f = []. In other words, [] *is* the type constructor. In Haskell, [] is both the type constructor for lists *and* the term level value for an empty list. This is unfortunate. In ghci you can see this. ? :t [] [] :: [t] -- term level ? :k [] [] :: * -> * -- type level - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWhSk5AAoJENQqWdRUGk8BPHcQAOHzfxcEQ+ZTQ5VMZjNo2cC5 5dXKFg2h0jGho4FhUNWeJ4EPSiyYHTEmyK3ZL2KSYoTVAPq/PyeZMdJFRgVRAeyz Ktyv00E9oJQqjxUrZi7YiE+Y/KteqjE8Hy0X9QW7ICgcU1M9a13o6L+CLdoYrCj8 K6Dto35O7aZRLLQTjoZBm0I6VeDF9WDJPQwZrmXopXhixKrEad8EPne/Tt/yXlTr Yl2Wya5w+f/xkD6G3T7nHz6Z2CtVhzfqTMO+9OoDkNnt8kFC1ZCsdDicbryEcvEA 0WlURPfjTMRCffrKz8N5SeyzgSF29EJATY2U9yg1l2gajiHxo+Veg1HXF2EMr5RZ HF1DJyykXOOpel2VBY+ljtUsVP2J1gF7CoGjAzQnIQhGq3n/DOzmieRCZrZ4eC2W 8gUKyQwd4VPSI+YCZ+io9/NIXETpA+TIUdEYI5Goje4laN5lvddwAc0ADAbWPfyt bsVjlmu3nC3EhG/7qw3KfA4KBiCXU8hH+8zvzDFYjBMX2bxnd/42jiJ8HyNVPYhW s1FB3ndNUU/tHQzsSye3DXdL6mZ/PsDCT4RAcKc6HMTOP2K04DR8Nmo9Ag6RV0Pw VomcJkESFZYYG1vPrdbxDRAWJgGIsMd1UpuPe5r6uzj06Xh9zmoLIqVxB3u2Um8k AnGPKK8WBdguP09bjG0Q =8v7y -----END PGP SIGNATURE----- From daniel.trstenjak at gmail.com Thu Dec 31 13:35:36 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Thu, 31 Dec 2015 14:35:36 +0100 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5685284A.3010702@web.de> References: <5685284A.3010702@web.de> Message-ID: <20151231133536.GA4227@octa> On Thu, Dec 31, 2015 at 01:06:18PM +0000, Olumide wrote: > Why does 'f' not appear in this expression?, considering that Functor is > defined as instance Functor [] where fmap = map is the eta reduced - search for eta reduction for the details - of a version like: instance Functor [] where fmap g f = map g f Greetings, Daniel From fa-ml at ariis.it Thu Dec 31 13:33:06 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Thu, 31 Dec 2015 14:33:06 +0100 Subject: [Haskell-beginners] Why must inflix constructors begin with a colon? In-Reply-To: <5685251C.9000205@web.de> References: <5685251C.9000205@web.de> Message-ID: <20151231133306.GA8905@casa.casa> On Thu, Dec 31, 2015 at 12:52:44PM +0000, Olumide wrote: > I'm new to Haskell and wondering why this restriction? > > For example (from LYH): > > infixr 5 :-: > data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) Not a committee member, but there is a similar restriction (dichotomy, rather) with 'functions' (first char lowercase) and 'constructors' (first char uppercase), so mirroring it to infix operators/constructors seems reasonable. From timmelzer at gmail.com Thu Dec 31 13:42:50 2015 From: timmelzer at gmail.com (Norbert Melzer) Date: Thu, 31 Dec 2015 13:42:50 +0000 Subject: [Haskell-beginners] Why must inflix constructors begin with a colon? In-Reply-To: <20151231133306.GA8905@casa.casa> References: <5685251C.9000205@web.de> <20151231133306.GA8905@casa.casa> Message-ID: I'm not a member of the commitee either, but I do think it is to make the grammar context free and give the parser an easy way to distinguish. Because of the design as it is now, already a lexer can decide whether we have a function or an constructor operator. Francesco Ariis schrieb am Do., 31. Dez. 2015 14:35: > On Thu, Dec 31, 2015 at 12:52:44PM +0000, Olumide wrote: > > I'm new to Haskell and wondering why this restriction? > > > > For example (from LYH): > > > > infixr 5 :-: > > data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) > > Not a committee member, but there is a similar restriction (dichotomy, > rather) with 'functions' (first char lowercase) and 'constructors' > (first char uppercase), so mirroring it to infix operators/constructors > seems reasonable. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: