I am making a program that lets 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
