使io程序更模块化

Question

我正在尝试制作一个让用户操作数据库（文本文件）的程序。

在我发布的代码中，我只显示了2个菜单选项，即“createdb”和“deletedb”，以及一些我拼命使功能更紧凑的功能。但我的问题是该模式与所有其他菜单选项类似。我要求用户输入数据库的名称或“b”返回到菜单，然后检查文件是否存在。

有没有一种方法可以很容易地分开这个，使我的代码更紧凑？我尝试在菜单中做这个部分，并有选择功能类型

FilePath -> IO() 

但是，然后我的菜单看起来非常可怕。以下是一小部分代码：

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

您正在寻找Exception monad transformer。

的如何使用它的一个例子：

import Control.Monad.Except 

data ExitType = ToMenu | Error String 

deletedb :: ExceptT ExitType IO() 
deletedb = do 
    name <- getName 
    fp <- getFile name 
    liftIO $ removeFile fp 

（甚至相当于一个班轮deletedb = liftIO . removeFile =<< getFile =<< getName！）

然后，你可以做的更好的退出处理的getName等：

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 

运行它的一个小例子：

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