Here is my current code, I want to be able to create a MAIN IO that acts as an interface and allows the user to pick which functions to execute depending on their choice.
type Title = String
type Actor = String
type Cast = [Actor]
type Year = Int
type Fan = String
type Fans = [Fan]
type Period = (Year, Year)
type Film = (Title, Cast, Year, Fans)
type Database = [Film]
title (t, _, _, _) = t
cast (_, c, _, _) = c
year (_, _, y, _) = y
fans (_, _, _, fs) = fs
testDatabase :: Database
testDatabase = [("Casino Royale", ["Daniel Craig", "Eva Green", "Judi Dench"], 2006, ["Garry", "Dave", "Zoe", "Kevin", "Emma"]),
("Cowboys & Aliens", ["Harrison Ford", "Daniel Craig", "Olivia Wilde"], 2011, ["Bill", "Jo", "Garry", "Kevin", "Olga", "Liz"]),
("Catch Me If You Can", ["Leonardo DiCaprio", "Tom Hanks"], 2002, ["Zoe", "Heidi", "Jo", "Emma", "Liz", "Sam", "Olga", "Kevin", "Tim"])]
Function 1:
displayAllFilms' :: [Film] -> String -> String
displayAllFilms' [] filmString = filmString
displayAllFilms' ((title,cast,year,fans):films) filmString =
displayAllFilms' films (filmString ++ "\n" ++ title ++ ", " ++ listStuff cast ", " ++ (show year) ++ ", " ++ show (length fans))
Function 2:
filmsByFan f = map title $ filter (elem f . fans) testDatabase
The above code is 100% working and I am able to pull the information out of the given database.
Here is the example MAIN IO that I have created:
main :: IO ()
main = do putStrLn "What function would you like to execute? 1. addFilm / 2.displayAllFilms / 3. filmsByYear / 4. filmsByFan / 5. filmsByActor Period / 6. becomeFan: "
str <- getLine
if str /= "2"
then return ()
else do putStrLn (displayAllFilms' testDatabase str)
if str /= "4"
then return ()
else do putStrLn "Enter an existing fan: "
name <- getLine
putStrLn filmsByFan name <<< **error here**
main
The problem I am having is when more than 2 functions are applied to the IO if statement, it doesn't seem to register when 'name' is assigned by a user input and thus the rest of the code from name <- getLine does not compile.
My question is: Is there a way for the user to select what function to execute depending on what they have chosen and execute the appropriate function...?
Thanks in advance!
Edit:
Example on how I wish the code to execute:
Main
which function would you like to execute...1,2,3,4,5,6?
user enters: 1
displayFilms will execute.
IF USER ENTERS 4
user enters: 4
Enter an existing fan:
user enters: Liz"
execute filmsByFan
You say the error message you get is
ExampleSolution.hs:167:12: parse error on input `do'
You don't say which line is line 167.
You appear to be mixing spaces and tabs. This may be the cause of the problem. Replace all tabs in your source code with spaces.
Edit: I said you appear to be mixing spaces and tabs because the source code in your question mixes spaces and tabs. e.g. the indentation of the line with the error ends with tabs, whereas the indentation in the line above it ends with eight spaces and does not appear to be indented as far.
This is consistent with the lines
name <- getLine
putStrLn filmsByFan name
actually being
name <- getLine
putStrLn filmsByFan name
and being interpreted as
name <- getLine putStrLn filmsByFan name
which would cause the error you now report:
ExampleSolution.hs:174:61: Not in scope: `name'
as name is defined on the left of the <- and thus not available for use on the right: it is only available for use in subsequent lines in the block.
Check that your editor is not converting spaces to tabs when it saves your file, contrary to your wishes. Alternatively, ensure that it uses 8-space-wide tabs (I would guess that you're probably using 4-space-wide tabs).
n.b. You probably intend for these lines to read
name <- getLine
putStrLn (filmsByFan name)
You could put all the functions in a table, and use lookup to select which one to run.
table = [(1, addFilm)
,(2, displayAllFilms)
,(3, filmsByYear)
,(4, filmsByFan)
]
I renamed your filmsByFan to filmsByFan' (prime), so I could add a layer to prompt for the key and call your orig function:
filmsByFan = do putStr "Enter Fan"
f <- getLine
print $ filmsByFan' f
filmsByFan' f = map title $ filter (elem f . fans) testDatabase
main :: IO ()
main = do putStrLn "What function would you like to execute? 1. addFilm / 2.displayAllFilms / 3. filmsByYear / 4. filmsByFan / 5. filmsByActor Period / 6. becomeFan: "
str <- getLine
let n = (read str)::Int
cmd = lookup n table
case cmd of
Just doIt -> doIt
Nothing -> do print "sorry"
main
Related
I know what an indentation error is, but I have no idea why I'm getting this error here, while every is aligned, trying to solve it for 2 hours.
Account.hs:40:25: error:
parse error (possibly incorrect indentation or mismatched brackets)
|
40 | let amount = readLn :: IO Int
| ^
Failed, 0 modules loaded.
main = do
putStrLn $ "Press one to create a new account"
let g = getLine
enteredValue = read g :: Int
if g == 1
then do putStrLn $ "Enter your name "
let name = getLine
putStrLn $ "Enter the initial amount"
let amount = readLn :: IO Int
value = Account (name,1,amount) Saving
show value
else do putStrLn $ "Nothing"
I also tried this version but this also gives incorrect indentation or mismatched brackets:
main = do
putStrLn $ "Press one to create a new account"
let g = getLine
enteredValue = read g :: Int
if g == 1
then do putStrLn $ "Enter your name "
let name = getLine
putStrLn $ "Enter the initial amount"
amount = readLn :: IO Int
value = Account (name,1,amount) Saving
show value
else do putStrLn $ "Nothing"
The problem is here:
-- |<---- "column 0" of this 'do' block
then do putStrLn $ "Enter your name "
-- | still good; a 'let' statement:
let name = getLine
-- |<---- "column 0" of this 'let' block
putStrLn $ "Enter the initial amount"
-- | Huh, there's no '=' in ^this^ declaration?
let amount = readLn :: IO Int
-- ^^^ Why is there a 'let' within another let binding?
-- I still haven't seen a '='. Better throw a parse error.
Basically, putStrLn $ "Enter the initial amount" is aligned with name = ... in the preceding line, so the compiler reads it as a declaration (part of the same let block).
To fix your indentation errors, it should be:
main = do
putStrLn $ "Press one to create a new account"
let g = getLine
enteredValue = read g :: Int
if g == 1
then do putStrLn $ "Enter your name "
let name = getLine
putStrLn $ "Enter the initial amount"
let amount = readLn :: IO Int
value = Account (name,1,amount) Saving
show value
else do putStrLn $ "Nothing"
But then you'll run into type errors:
read g is wrong: read takes a String, but g :: IO String
g == 1 is wrong: 1 is an Int, but g :: IO String
show value is wrong: show returns a String, but you're using it as an IO action
You haven't shown the declaration of Account, but you're likely going to have issues with name and amount, too
You probably want something like:
main = do
putStrLn $ "Press one to create a new account"
g <- getLine
let enteredValue = read g :: Int
if enteredValue == 1
then do putStrLn $ "Enter your name "
name <- getLine
putStrLn $ "Enter the initial amount"
amount <- readLn :: IO Int
let value = Account (name,1,amount) Saving
putStrLn (show value)
else do putStrLn $ "Nothing"
Basically, use v <- expr to go from expr :: IO Something to v :: Something.
Other notes:
g <- getLine; let enteredValue = read g :: Int better written as enteredValue <- readLn :: IO Int
putStrLn (show value) can be shortened to print value
you don't need do for a single expression (nor $ for a single operand): ... else putStrLn "Nothing"
There is more wrong to your code than just the Indentation Errors - so my first suggestion would be reading a bit of learn you a haskell for great good.
Next there are two assignment operators in haskell - one binds the result of an action … <- … and the other one is a local definition/declaration of a pure computation let … = ….
Moreover you can improve your reading a value by taking account of the possible false input, that someone could give you (intentionally and unintentionally) by replacing read with readMaybe, where the latter returns a Maybe something, for example readMaybe "1" = Just 1 :: Maybe Int or readMaybe "foo" = Nothing :: Maybe Int.
Regarding your indentation it is best that you compare one solution to your program with yours own:
import Text.Read (readMaybe)
data Type = Saving | Checking
deriving (Show)
data Account = Account (String,Int,Int) Type
deriving (Show)
main :: IO ()
main = do
putStrLn "Press one to create a new account"
g <- getLine
let enteredValue = readMaybe g :: Maybe Int
here the result of getLine and entered value have the same scope so they have the same indentation - we only change the scope after the next if where the then-block - and the else-block do not share the 'declarations' of each branch, so you couldn't use name in the else-block, but enteredValue can be used in both.
if enteredValue == Just 1
then do putStrLn "Enter your name "
name <- getLine
putStrLn "Enter the initial amount"
amount' <- fmap readMaybe getLine
here again name and amount' share the same scope, and pattern matching on amount' creates a new scope where amount is visible and the match on Nothing where you cannot use this variable.
case amount' of
Just amount -> print $ Account (name,1,amount) Saving
Nothing -> putStrLn "Nothing"
else putStrLn "Nothing"
let is for binding values, which is done in the form let x = y+z, where x is the name (aka "identifier") being bound, and y+z is the expression to which it is being bound.
In your example, I see three bindings: name, amount, and value. The rest are not value bindings, but actions.
In the do notation, actions do not need a let. You just write them one after another. So:
let name = getLine
putStrLn $ "Enter the initial amount"
let amount = readLn :: IO Int
let value = Account (name,1,amount) Saving
show value
But wait! This is not all!
getLine is not actually an expression of type String, as you seem to be hoping here. Rather, getLine is an action. In order to get it to "run" and "produce" a String value, you need to use the <- construct instead of let:
name <- getLine
Similarly with readLn:
amount <- readLn :: IO Int
Finally, show value is not actually an action that would print the value to the screen. show is a function that takes a value and return a String. It doesn't "do" anything (i.e. doesn't produce any outside effects), so you can't use it in place of an action in the do notation. If you wanted an action that would print a value to the screen, that would be print:
print value
Gathering everything together:
name <- getLine
putStrLn $ "Enter the initial amount"
amount <- readLn :: IO Int
let value = Account (name,1,amount) Saving
print value
And after fixing all of that, you'll have similar difficulties with the first part of your program, where you have let g = getLine instead of g <- getLine.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
I am attempting to make a program that let's a user manipulate a database (a text file).
In the code I am posting, I show only 2 of the menu choices, namely "createdb" and "deletedb", and a few functions I made to desperately make the functions more compact. But my problem is that the pattern is similiar for all the other menu options. I ask the user to either enter the name of the database or "b" to return to the menu, and then check if the file exists.
Is there a way I can easily separate this to make my code more compact? I tried to do this part in the menu and have the choice functions be of type
FilePath -> IO ()
But then my menu looked really terrible. Here is a small part of the code:
type Choice = (String, String, IO ())
choices :: [Choice]
choices =
[("a", "create a database", createdb),
("b", "delete a database", deletedb),
("c", "insert an entry to a database", insert),
("d", "print a database", selectall),
("e", "select entries from a database", select),
-- more similiar choices
menu :: IO ()
menu = do
(mapM_ putStrLn . map showChoice) choices
c <- get "Enter the letter corresonding to the action of choice:"
case filter ((== c) . fst3) choices of
[] -> back "Not a valid choice. Try again"
(_, _, f) : _ -> f
createdb :: IO ()
createdb = do
n <- maybeName
if isNothing n then menu else do
let name = fromJust n
fp <- maybeFile name
if isJust fp
then back $ "Error: \"" ++ name ++ "\" already exist."
else do
cols <- get "Enter unique column names in the form n1,n2,...,n (No spaces):"
let spl = (splitOnComma . toLower') cols
case filter (== True) (hasDuplicates spl : map (elem ' ') spl) of
[] -> writeFile (name ++ ".txt") (cols ++ "\n")
_ -> back "Error: Column names must be unique and have no spaces."
deletedb :: IO ()
deletedb = do
n <- maybeName
if isNothing n then menu else do
let name = fromJust n
fp <- maybeFile name
if isJust fp
then removeFile (fromJust fp)
else back $ "Error: Could not find " ++ name
maybeName :: IO (Maybe String)
maybeName = do
input <- get "Enter database name or 'b' to go back to the menu."
return $ case input of
"b" -> Nothing
_ -> Just input
maybeFile :: String -> IO (Maybe FilePath)
maybeFile name = do
let fn = name ++ ".txt"
exists <- doesFileExist fn
return $ if exists then Just fn else Nothing
back :: String -> IO ()
back msg = do
putStrLn msg
menu
get :: String -> IO String
get msg = do
putStrLn msg
getLine
You're looking for the Exception monad transformer.
An example of how you might use it:
import Control.Monad.Except
data ExitType = ToMenu | Error String
deletedb :: ExceptT ExitType IO ()
deletedb = do
name <- getName
fp <- getFile name
liftIO $ removeFile fp
(or even the equivalent one-liner deletedb = liftIO . removeFile =<< getFile =<< getName !)
Then you can do better exit handling in getName etc:
getName :: ExceptT ExitType IO String
getName = do
input <- liftIO $ get "Enter database name or 'b' to go back to the menu."
case input of
"b" -> throwError ToMenu
_ -> return input
A small example of running it:
menu :: IO ()
menu = do
let action = deletedb -- display menu here to choose action
r <- runExcept action
case r of
Left ToMenu -> menu
Left (Error errmsg) -> putStrLn errmsg >> menu
Right result -> print result
I am trying to use Haskeline to write a program which asks the user a sequence of questions, each one optionally with a default value in [brackets], and reads in their responses. I want the user to be able to
Press Enter to submit the [default] value;
Type in a string, edit it if needed, and then press Enter to submit this value;
Press Ctrl-C to reset all values to the defaults and start over; and,
Press Ctrl-D or enter "quit" to quit, in which case all the values which they submitted are lost.
I have been able to get points 1-3 working, but I cannot get point 4 to work: pressing Ctrl-D (or entering "quit") just brings up the next prompt instead of making the program quit the questioning. Looking at my program (please see below) I understand why this happens, but I am not able to figure out how to fix this so that Ctrl-D (or "quit") actually makes the questioning stop. How do I fix the program to make this happen?
I did see this question which seems to ask something similar, but I could not get much from there; I am not even sure that they are asking the same question as I am.
As a secondary question: my current program has quite a few case statements which switch on Maybe values. In particular, I currently check for Nothing two or three levels deep so that I can correctly return a Nothing when the user presses Ctrl-D. I have a feeling that this could be simplified using (something like) the monadic >>= operator, but I am unable to figure out how to do this in this case. Is my hunch right? Is there a way to do away with all this pattern matching which looks for Nothing?
Also: please tell me anything else which could improve my code below. I am quite new to this, so it is very likely that I am missing many obvious things here.
My program asks the user about the composition of a fruit basket. The information associated with a fruit basket consists of the name of the owner of the fruit basket and the names of the different kinds of fruit in the basket. To be able to ask for the latter, I first ask for the number of different kind of fruit in the basket, and then ask for the name of each kind. We start with a default fruit basket whose information is then modified as per what the user tells us.
module Main where
import System.Console.Haskeline
type PersonName = String
type FruitName = String
data FruitBasket = FruitBasket { ownerName :: PersonName,
fruitCount :: Int,
fruitNames :: [FruitName]
} deriving Show
defaultBasket = FruitBasket "Mary" 2 ["Apple", "Peach"]
main :: IO ()
main = do
basket <- getBasketData defaultBasket
putStrLn $ "Got: " ++ show(basket)
-- Prompt the user for information about a fruit basket, and
-- return a FruitBasket instance containing this information. The
-- first argument is an instance of FruitBasket from which we get
-- the default values for the various prompts. The return value
-- has a Maybe type because the user may abort the questioning, in
-- which case we get nothing from them.
getBasketData :: FruitBasket -> IO (Maybe FruitBasket)
getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket
where
getData :: FruitBasket -> InputT IO (Maybe FruitBasket)
getData initialBasket = handleInterrupt f $ do
outputStrLn banner
input <- getInputLine $ "Who owns this basket? [" ++ defaultOwner ++ "] : "
basket <- case input of
Nothing -> return Nothing -- User pressed Ctrl-D with the input being empty
Just "" -> return (Just initialBasket) -- User pressed Enter with the input being empty
Just "quit" -> return Nothing -- User typed in "quit" and pressed Enter
Just newOwner -> return (Just initialBasket{ownerName = newOwner})
input <- getInputLine $ "Number of kinds of fruit in the basket? [" ++ show defaultCount ++ "] : "
basket' <- case input of
Nothing -> return Nothing
Just "" -> return basket
Just "quit" -> return Nothing
Just count -> return $ updateFruitCount basket (read count)
where updateFruitCount Nothing _ = Nothing
updateFruitCount (Just realBasket) newCount = Just $ realBasket{fruitCount = newCount}
let defaultFruitNames = pruneOrPadNames basket'
newNames <- getFruitNames defaultFruitNames 1
case newNames of
Nothing -> return (Just defaultBasket)
Just newSetOfNames -> return $ updateFruitNames basket' newSetOfNames
where updateFruitNames Nothing _ = Nothing
updateFruitNames (Just realBasket) realNewNames = Just $ realBasket{fruitNames = realNewNames}
where f = (outputStrLn "Press Ctrl-D or enter \"quit\" to quit." >> getData initialBasket)
defaultOwner = ownerName initialBasket
defaultCount = fruitCount initialBasket
banner :: String
banner = "Please enter details of the fruit basket below. At each prompt you can do one of the following:\n\
\\t (a) Press Enter to submit the [default] value;\n\
\\t (b) Type in a string, edit it if needed, and then press Enter to submit this value;\n\
\\t (c) Press Ctrl-C to reset all values to the defaults and start over;\n\
\\t (d) Press Ctrl-D or enter \"quit\" to quit; all the values you submitted will be lost."
pruneOrPadNames :: Maybe FruitBasket -> Maybe [String]
pruneOrPadNames Nothing = Nothing
pruneOrPadNames (Just basket) = Just $ pruneOrPad (fruitNames basket) (fruitCount basket)
-- When requiredLength is not larger than (length inputList),
-- (pruneOrPad inputList requiredLength) is the prefix of
-- inputList of length requiredLength. Otherwise, it is inputList
-- padded with as many empty strings as required to make the total
-- length equal to requiredLength.
pruneOrPad :: [String] -> Int -> [String]
pruneOrPad inputList requiredLength
| requiredLength <= inputLength = take requiredLength inputList
| otherwise = inputList ++ (replicate difference "")
where inputLength = length inputList
difference = requiredLength - inputLength
getFruitNames Nothing _ = return Nothing
getFruitNames (Just []) _ = return $ Just [""]
getFruitNames (Just (name:names)) count = do
input <- getInputLine $ "Name of fruit " ++ (show count) ++ " [" ++ name ++ "] : "
newNames <- case input of
Nothing -> return Nothing
Just "" -> do -- Keep the default name for this fruit ...
newNames' <- getFruitNames (Just names) (count + 1)
case newNames' of
Nothing -> return Nothing
-- ... unless the user chose to quit
-- while entering a name
Just [""] -> return $ Just [name]
-- At this point names = [] so it is
-- already time to stop asking for
-- more names.
Just furtherNames -> return $ Just (name : furtherNames)
Just "quit" -> return Nothing
Just name' -> do
newNames' <- getFruitNames (Just names) (count + 1)
case newNames' of
Nothing -> return Nothing
Just [""] -> return $ Just [name']
Just furtherNames -> return $ Just (name' : furtherNames)
return newNames
With help from some of the advice here on the haskell-beginners mailing list I have managed to solve my problems, the Ctrl-D question entirely and the factoring question to my own satisfaction (as of now!). I am posting the answer here in the hope it helps others in my predicament.
First, the trouble with the Ctrl-D: The problem was that I was throwing away the control logic offered by the Maybe monad and just using the values from the monad, by referring to various variable names which contained these values. The first place where I do this is here, in the getBasketData function:
basket <- case input of ...
input <- getInputLine ...
basket' <- case input of
Nothing -> return Nothing
Just "" -> return basket
Notice how, in computing basket', I
Ignore the case where basket could have been Nothing, and
Use the value encapsulated by basket by referring to (and pattern matching on, when needed) the variable basket which is still in scope inside the expression for basket'.
This is the where the Ctrl-D was lost. Here, for contrast, is code for getBasketData which does not let the Nothings slip through the gaps (I renamed the basket variables to maybeBasket, because they are really instances of Maybe FruitBasket):
getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket
where
getData :: FruitBasket -> InputT IO (Maybe FruitBasket)
getData initialBasket = handleInterrupt f $ do
outputStrLn banner
input <- getInputLine $ "Who owns this basket? [" ++ defaultOwner ++ "] : "
maybeBasket <- case input of
Nothing -> return $ Nothing -- User pressed Ctrl-D with the input being empty
Just "" -> return $ Just initialBasket -- User pressed Enter with the input being empty
Just "quit" -> return $ Nothing -- User typed in "quit" and pressed Enter
Just newOwner -> return $ Just initialBasket{ownerName = newOwner}
maybeBasket' <- case maybeBasket of
Nothing -> return $ Nothing
Just realBasket -> do input <- getInputLine $ "Number of kinds of fruit in the basket? [" ++ show defaultCount ++ "] : "
case input of
Nothing -> return $ Nothing
Just "" -> return $ maybeBasket
Just "quit" -> return $ Nothing
Just count -> return $ Just $ realBasket{fruitCount = (read count)}
maybeBasket'' <- case maybeBasket' of
Nothing -> return $ Nothing
Just realBasket -> do let defaultFruitNames = pruneOrPad (fruitNames realBasket) (fruitCount realBasket)
newNames <- getFruitNames defaultFruitNames 1
case newNames of
Nothing -> return $ Nothing
Just newSetOfNames -> return $ Just $ realBasket{fruitNames = newSetOfNames}
return maybeBasket''
where f = (outputStrLn interruptMessage >> getData initialBasket)
defaultOwner = ownerName initialBasket
defaultCount = fruitCount initialBasket
Thus, for instance, we try to do any real computation to get maybeBasket' --- including presenting the prompt for the number of different kinds of fruit --- only if maybeBasket is not Nothing.
This solves the Ctrl-D problem: the program now stops questioning and returns Nothing if the user presses Ctrl-D in response to any question.
Now onto the factoring. This is where advice from the mailing list answer helped: I started out by splitting up the big getData function into three pieces, one for each "big" use of the <- operator, and put these pieces into separate functions. This cleared up the logic a lot for me (indeed, this is how I found the fix to the Ctrl-D problem as well). Starting with this, I kept rephrasing the various parts till I got the following version which looks good enough to me. Notice how small and clean the getBasketData function has become!
module Main where
import System.Console.Haskeline
type PersonName = String
type FruitName = String
data FruitBasket = FruitBasket { ownerName :: PersonName,
fruitCount :: Int,
fruitNames :: [FruitName]
} deriving Show
defaultBasket :: FruitBasket
defaultBasket = FruitBasket "Mary" 2 ["Apple", "Peach"]
main :: IO ()
main = do
basket <- getBasketData defaultBasket
putStrLn $ "Got: " ++ show(basket)
-- Prompt the user for information about a fruit basket, and
-- return a FruitBasket instance containing this information. The
-- first argument is an instance of FruitBasket from which we get
-- the default values for the various prompts. The return value
-- has a Maybe type because the user may abort the questioning, in
-- which case we get nothing from them.
getBasketData :: FruitBasket -> IO (Maybe FruitBasket)
getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket
where
getData :: FruitBasket -> InputT IO (Maybe FruitBasket)
getData initialBasket = handleInterrupt f $ do
outputStrLn banner
(ownerQ initialBasket) >>= (processOwner initialBasket) >>= processCount >>= processNames
where f = (outputStrLn interruptMessage >> getData initialBasket)
ownerQ :: FruitBasket -> InputT IO (Maybe PersonName)
ownerQ basket = getInputLine $ "Who owns this basket? [" ++ (ownerName basket) ++ "] : "
processOwner :: FruitBasket -> Maybe PersonName -> InputT IO (Maybe FruitBasket)
processOwner _ Nothing = return Nothing
processOwner _ (Just "quit") = return Nothing
processOwner basket (Just "") = return $ Just basket
processOwner basket (Just newOwner) = return $ Just basket{ownerName = newOwner}
processCount :: Maybe FruitBasket -> InputT IO (Maybe FruitBasket)
processCount Nothing = return Nothing
processCount (Just basket) = (fruitTypesQ basket) >>= processCount'
where processCount' :: Maybe String -> InputT IO (Maybe FruitBasket)
processCount' Nothing = return Nothing
processCount' (Just "quit") = return Nothing
processCount' (Just "") = return $ Just basket
processCount' (Just count) = return $ Just basket{fruitCount = (read count)}
fruitTypesQ :: FruitBasket -> InputT IO (Maybe String)
fruitTypesQ basket = getInputLine $ "Number of kinds of fruit in the basket? [" ++ show (fruitCount basket) ++ "] : "
processNames :: Maybe FruitBasket -> InputT IO (Maybe FruitBasket)
processNames Nothing = return Nothing
processNames (Just basket) = input >>= processNames'
where input = getFruitNames defaultFruitNames 1
defaultFruitNames = pruneOrPad (fruitNames basket) (fruitCount basket)
processNames' :: Maybe [FruitName] -> InputT IO (Maybe FruitBasket)
processNames' Nothing = return Nothing
processNames' (Just newSetOfNames) = return $ Just basket{fruitNames = newSetOfNames}
banner :: String
banner = "Please enter details of the fruit basket below. At each prompt you can do one of the following:\n\
\\t (a) Press Enter to submit the [default] value;\n\
\\t (b) Type in a string, edit it if needed, and then press Enter to submit this value;\n\
\\t (c) Press Ctrl-C to reset all values to the defaults and start over;\n\
\\t (d) Press Ctrl-D or enter \"quit\" to quit; all the values you submitted will be lost."
interruptMessage :: String
interruptMessage = "#################################################\n\
\You pressed Ctrl-C.\n\
\We will now reset all values and start over.\n\
\To quit, press Ctrl-D or enter \"quit\".\n\
\#################################################\n"
pruneOrPadNames :: Maybe FruitBasket -> Maybe [String]
pruneOrPadNames Nothing = Nothing
pruneOrPadNames (Just basket) = Just $ pruneOrPad (fruitNames basket) (fruitCount basket)
-- When requiredLength is not larger than (length inputList),
-- (pruneOrPad inputList requiredLength) is the prefix of
-- inputList of length requiredLength. Otherwise, it is inputList
-- padded with as many empty strings as required to make the total
-- length equal to requiredLength.
pruneOrPad :: [String] -> Int -> [String]
pruneOrPad inputList requiredLength
| requiredLength <= inputLength = take requiredLength inputList
| otherwise = inputList ++ (replicate difference "")
where inputLength = length inputList
difference = requiredLength - inputLength
getFruitNames :: [FruitName] -> Int -> InputT IO (Maybe [FruitName])
getFruitNames [] _ = return $ Just [""]
getFruitNames (name:names) count = do
input <- getInputLine $ "Name of fruit " ++ (show count) ++ " [" ++ name ++ "] : "
newNames <- case input of
Nothing -> return Nothing
Just "" -> do -- Keep the default name for this fruit ...
newNames' <- getFruitNames names (count + 1)
case newNames' of
Nothing -> return Nothing
-- ... unless the user chose to quit
-- while entering a name
Just [""] -> return $ Just [name]
-- At this point names = [] so it is
-- already time to stop asking for
-- more names.
Just furtherNames -> return $ Just (name : furtherNames)
Just "quit" -> return Nothing
Just name' -> do
newNames' <- getFruitNames names (count + 1)
case newNames' of
Nothing -> return Nothing
Just [""] -> return $ Just [name']
Just furtherNames -> return $ Just (name' : furtherNames)
return newNames
The moral of this story seems to be: "When confused, break things down."
I think your hunch is right here. Much of the pattern matching done via case can be replaced with using the Maybe Monad a bit more.
Instead of
basket <- case input of
Nothing -> return Nothing -- User pressed Ctrl-D with the input being empty
Just "" -> return (Just initialBasket) -- User pressed Enter with the input being empty
Just "quit" -> return Nothing -- User typed in "quit" and pressed Enter
Just newOwner -> return (Just initialBasket{ownerName = newOwner})
you could write something like
let basket' = do
i <- input
guard $ i /= "quit"
b <- basket
return $ if (null i) then b else b{fruitCount = read i}
you could even introduce some helpers like
guardInput :: Maybe String -> (String -> Maybe a) -> Maybe a
guardInput input λ = input >>= \i -> ((guard $ i /= "quit") >> λ i)
-- | Custom ternary operator .)
True ? (a, _) = a
False ? (_, b) = b
to write
let basket = guardInput input $
\i -> return $ (null i) ? (initialBasket, initialBasket{ownerName = i})
Sorry - I know this doesn't answer your problem with Ctrl+D, but I haven't figured that one out myself (yet).
At the moment, I have this code in and around main:
import Control.Monad
import Control.Applicative
binSearch :: Ord a => [a] -> a -> Maybe Int
main = do
xs <- lines <$> readFile "Cars1.txt"
x <- getLine <* putStr "Registration: " -- Right?
putStrLn $ case binSearch xs x of
Just n -> "Found at position " ++ show n
Nothing -> "Not found"
My hope is for “Registration: ” to be printed, then for the program to wait for the input to x. Does what I've written imply that that will be the case? Do I need the <*, or will putting the putStr expression on the line above make things work as well?
PS: I know I have to convert binSearch to work with arrays rather than lists (otherwise it's probably not worth doing a binary search), but that's a problem for another day.
The line
x <- getLine <* putStr "Registration: "
orders the IO actions left-to-right: first a line is taken as input, then the message is printed, and finally variable x is bound to the result of getLine.
Do I need the <*, or will putting the putStr expression on the line
above make things work as well?
If you want the message to precede the input, you have to put the putStr on the line above, as follows:
main :: IO ()
main = do
xs <- lines <$> readFile "Cars1.txt"
putStr "Registration: "
x <- getLine
putStrLn $ case binSearch xs x of
Just n -> "Found at position " ++ show n
Nothing -> "Not found"
Alternatively,
x <- putStr "Registration: " *> getLine
or
x <- putStr "Registration: " >> getLine
would work, but they are less readable.
Finally, since you added the lazy-evaluation tag, let me add that your question is actually not about laziness, but about how the operator <* is defined, and in particular about the order in which it sequences the IO actions.
Sorry for a poor title, feel free to edit. I can't understand what the problem is, so it might be altogether wrong. Below is the code (this is after I've done like a hundred of permutations and different sequences of let-do-if and tabulation, and I'm exhausted):
-- The last statement in a 'do' construct must be an expression
numberOfGoods :: IO String
numberOfGoods = do putStrLn "Enter year (2000-2012):\n"
let intYear = readYear
in if (intYear < 2000 || intYear > 2012)
then error "Year must be withing range: 2000-2012"
else
c <- readIORef connection
[Only i] <- query_ c ("select count('*')" ++
"from table" ++
"where ((acquisition_date <= " ++
(formatDate intYear) ++
") and ((sale_date is null) or " ++
"(sale_date < " ++
(formatDate intYear) ++ ")))")
return i
readYear :: Integer
readYear = do
year <- getLine
read year :: Integer
Something that would meant to be so simple... I still don't understand what is wrong with the code above. Please, if you could kindly explain the source of the error, that would be great.
I did read about do, let-in and if-then-else, and I don't see any errors here from what I could understand from the manual.
Ideally, if there are alternatives, I would like very much to reduce the amount of the wasted white space on the left.
Thank you.
readYear is not an Integer, it's an IO action that can be run to read input and convert the input to an integer -- in other words, IO Integer. And as it's an IO action, you'll need a return to use whatever read year as result of getYear. That is:
getYear :: IO Integer
getYear = do year <- getLine
return (read year)
This also means you use it like intYear <- readYear instead of using let (well, you could, but you'd store the IO action instead of running it, and the type of intYear would be wrong). That is:
numberOfGoods :: IO String
numberOfGoods = do putStrLn "Enter year (2000-2012):\n"
intYear <- readYear
...
do does not extend over if, rather you need to start again with do if you want a sequence of actions in the then or else branch. That is:
else
c <- readIORef connection
...
return i
should be roughly:
else do c <- readIORef connection
...
return i
As for reducing whitespace, consider pushing the validation logic into readYear. Implementing this is left as an exercise to the reader ;)
As an aside, you don't need in when using let in a do block (but only there!), you can simply state:
do do_something
let val = pure_compuation
something_else_using val
You need a new do for every block of monadic functions: simply writing functions in a row has no meaning, regardless of whether they're monadic or pure. And everything where the value comes from the IO monad must itself give its return value in the monad.
numberOfGoods :: IO String
numberOfGoods = do putStrLn "Enter year (2000-2012):\n" -- why extra '\n'?
intYear <- readYear -- readYear expects user input <- must be monadic
if (intYear < 2000 || intYear > 2012)
then error "Year must be withing range: 2000-2012"
else do
c <- readIORef connection
[Only i] <- query_ c ("select count('*')" ++
"from table" ++
"where ((acquisition_date <= " ++
(formatDate intYear) ++
") and ((sale_date is null) or " ++
"(sale_date < " ++
(formatDate intYear) ++ ")))")
return i
readYear :: IO Integer
readYear = do
year <- getLine
return $ read year :: Integer
Why is an extra do needed...
Well, the thing with do in Haskell is that it's really just syntactic sugar. Let's simplify your function a little
nOG :: IO String
nOG = do putStrLn "Prompt"
someInput <- inputSth
if condition someInput
then error "Bloap"
else do c <- inputSthElse
[only] <- query_ c
return only
what this actually means is
nOG :: IO String
nOG = putStrLn "Prompt"
>> inputSth
>>= (\someInput ->
if condition someInput
then error "Bloap"
else inputSthElse
>>= (\s -> query_ c
>>= (\[only] -> return only )
)
)
Where you should be able to see that if behaves in exactly the same way as it does in a pure functional expression like shade (r,g,b) = if g>r && g>b then "greenish" else "purpleish". It doesn't in any way "know" about all the IO monad stuff going on around it, so it can't infer that there should again be a do block in one of its branches.