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 
