Making io program more modular [closed] - haskell

Question

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

Answer 1

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