3
\$\begingroup\$

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
\$\endgroup\$

1 Answer 1

0
\$\begingroup\$

I'd do Maybe FilePath -> IO ():

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) : _ -> maybeName >>= maybe menu (maybeFile >=> f)

createdb :: Maybe FilePath -> IO ()
createdb (Just file) = back $ "Error: \"" ++ file ++ "\" already exists." 
createdb Nothing = do
  cols <- get "Enter unique column names in the form n1,n2,...,n (No spaces):"
  let spl = splitOnComma $ toLower' cols
  if hasDuplicates spl || any (elem ' ') spl
    then back "Error: Column names must be unique and have no spaces."
    else writeFile (name ++ ".txt") (cols ++ "\n")

deletedb :: Maybe FilePath -> IO ()
deletedb Nothing = back $ "Error: Could not find that database."
deletedb (Just file) = removeFile file
\$\endgroup\$
5
  • \$\begingroup\$ Much better. thank you. But is the >=> a typo? Not familiar with that and >>= \$\endgroup\$ Nov 8, 2016 at 20:20
  • 2
    \$\begingroup\$ a >>= b is another way to write do x <- a; b x. a >=> b is another way to write \x -> do y <- a x; b y. You'll need to import Control.Monad for that one. \$\endgroup\$
    – Gurkenglas
    Nov 8, 2016 at 21:17
  • \$\begingroup\$ I kinda get it. For the 'createdb' function I need the reverse behaviour of all the other functions however. I tried to write it and ended up with this: ("a", _, f) : _ -> getName >>= maybe menu (\x -> do y <- getFile x; if isJust y then f Nothing else f (Just x)) Any better way to write this? \$\endgroup\$ Nov 8, 2016 at 23:40
  • \$\begingroup\$ Doesn't my implementation above already do that? \$\endgroup\$
    – Gurkenglas
    Nov 9, 2016 at 2:40
  • \$\begingroup\$ The createdb does writeFile name ++ ".txt" but I need the name \$\endgroup\$ Nov 9, 2016 at 8:27

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.