
I wrote to the group earlier this week regarding a haskell script to sort dates from input. Someone said: Why don't you write this up and send it to the list so that we can look at code rather than English text? So Here's the code... It is my first Haskell program so please forgive me if I broke any rules. I have been trying to debug it but keep running into walls, any and all help will be appreciated. import IO -- not really sure how to use globals variables. --myfile :: IO Handle myList :: [String] myList = [] --myDates :: [[String]] -- start is the main flow of the program. Each output will be used by -- the input of the next line or so I tried anyway. This was done so -- at the end I could compose the functions f1 . f2 . f3 ... start:: IO() start = do { putStr "Enter a filename: "; theFile <- getLine; myfile <- openFile theFile ReadMode; myList <- getInput myfile; myDates <- stripSpaces myList; myDates <- qSort myDates; myList <- formatOutput myDates; writeFile "output.txt" (getOutput (myList)); } -- get input was designed to suck in the input strings line by line -- into a list until there are no more lines -- Not at all sure how to do this I wallowed through -- example after example. getInput :: Handle -> [String] getInput myfile = while (do res <- hIsEOF myfile return (not res)) (do line <- hGetLine myfile return (line:myList)) -- Strip spaces turns the input strings into a list of strings -- so its [day, month, year] each of these being Int's -- this is done for easier sorting later on (or to make it possible) stripSpaces :: [String] -> [[String]] stripSpaces x = map words x -- The standard basic quicksort to be done using multidimensional -- lists. Never really got to this point yet, although I may -- rearrange this function to compare strings of the form... -- yyyy mm dd which should sort correctly then rearrange them -- once done for printing. qSort :: [[String]] -> [[String]] qSort [[]] = [[]] qSort ([x]:[xs]) = qSort elts_lt_x ++ [[x]] ++ qSort elts_greq_x where elts_lt_x = [[y] | [y] <- [xs], [y] < [x]] elts_greq_x = [[y] | [y] <- [xs], [y] >= [x]] -- this function puts each of the lists back into string form -- to format for output formatOutput:: [[String]] -> [String] formatOutput [n] = map unwords [n] -- This getoutput f(x) is designed to create the string to output to -- the file getOutput:: [String] -> String getOutput [] = [] getOutput (x:xs) = show x ++ "\n" -- -- this "while" function allowed me to write the above, it was in an -- example. while :: IO Bool -> IO () -> IO () while test action = do res <- test if res then do action while test action else return () The end. I am extremely lost and any and all help would be greatly appreciated. Michael _________________________________________________________________ Chat with friends online, try MSN Messenger: http://messenger.msn.com

So Here's the code... It is my first Haskell program so please forgive me if I broke any rules. I have been trying to debug it but keep running into walls, any and all help will be appreciated.
This is probably not quite what you expected, but I'd like to try a little experiment: instead of completely rewriting your code by thinking about what it should do, I've made it runnable through a series of small changes, trying to stick closely to the code you've given. And instead of giving you the resulting code, I'll just give you my change log, so that you can try to reproduce the steps. If this is absolutely no help, I can send my version of your code, but as this kind of problem comes up again and again, I'd first like to see whether this style of approach can be of more help than just posting a solution. Claus ---------change log follows 1. - eliminated globals myList, myDates, myfile - they don't seem to serve any purpose at the moment, and while your imperative programming style suggests that you want to use them, they shouldn't be necessary 2. - trying to load into Hugs - type error in use of while (in getInput): loop body returns something other than (). - you definitely want to keep the lines, so we have to change the definition of while, not its use (looking at getInput , which uses IO in the definition, but doesn't mention IO in its type, we'll have to change getInput as well, but first things first) 3. - according to the way getInput is used in start, I interpret your comments as saying getInput should return a list of Strings, one for each line of input. - getInput is defined in terms of while, so we need to make while return a list of Strings as well. - the action you pass to while is essentially hGetLine, so it seems easiest to adapt while to deal with an action that returns a String (instead of an action that returns nothing): while :: IO Bool -> IO a -> IO [a] 4. - this means we have to modify the use of while in getInput slightly: the body of the loop now only has to return a single line, and while takes care of collecting the lines into a list of Strings - however, all that still involves IO, so the type should be: getInput :: Handle -> IO [String] 5. - next stop (it helps to reload the partially correct program into Hugs every now and then, as a kind of minimum test suite, a program should load without problems): stripSpaces is a plain function stripSpaces :: [String] -> [[String]] As such, it cannot be used directly as an IO action. - either turn stripSpaces into an IO action, or (prefered) use it as the function it is to compute the parameter to qsort without IO (one way to do that: replace the monadic binding "myDates <- ..;" by a let binding "let {myDates = ..};" 6. - now we've got the same problem with qsort qSort :: [[String]] -> [[String]] It's a function, not an IO action - same remedy as before: use let to bind the sorted myDates 7. - next in line: formatOutput formatOutput:: [[String]] -> [String] no IO in sight, none needed. - you've heard this before:) use let to bind the result of formatOutput 8. - major breakthrough: the program loads for the first time! - we've not said anything about correctness yet, but you might want to clean up the code a bit before proceeding: - the let bindings in start can be merged, if you rename the variables a bit - e.g., call the result of qsort sortedDates instead of myDates (you could also inline the definitions, but names for intermediate values are a useful documentation aid) - in getInput, no do is needed for the body of the loop - just (hGetLine myfile) should do - it is always worth browsing the Haskell Prelude and Standard Libraries for things that do what you need: e.g., right next to hGetLine in module IO there is hGetContents, which combines nicely with lines from module PreludeList - its is good practice to close files you've opened after use; and as that is so easy to forget, module IO provides the bracket and bracket_ combinators (openFile and hClose are similar to opening and closing brackets around the part of the program that uses the filehandle) - does getOutput really give you the output you want? Having thus made your program runnable, you can now experiment (in fact, usually one would build up such programs by developing runnable, working fragments and composing them into bigger fragments). Having simplified the code, you can then think about correctness and efficiency.

"Michael Ruth"
start:: IO() start = do { putStr "Enter a filename: "; theFile <- getLine; myfile <- openFile theFile ReadMode; myList <- getInput myfile; myDates <- stripSpaces myList; myDates <- qSort myDates; myList <- formatOutput myDates; writeFile "output.txt" (getOutput (myList)); }
You might want to look up the function "readFile" in the Prelude. I must admit that while I've been using Haskell for odd bits and ends for a while now, I've not yet used a file handle -- still a lot of posted code seems to use them. Is this a creeping C-ism, or are handles genuinely useful, even if you simply are reading the content of a file to process it (i.e. typical Unix shell util usage)? -kzm -- If I haven't seen further, it is by standing in the footprints of giants
participants (3)
-
Claus Reinke
-
ketil@ii.uib.no
-
Michael Ruth