使io程序更加模块化[关闭]答案

【问题标题】：Making io program more modular [closed]使io程序更加模块化[关闭]
【发布时间】：2016-11-07 22:15:05
【问题描述】：

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

在我发布的代码中，我只显示了 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

【问题讨论】：

Code Review 可能是您提问的更好地方。
谢谢！ @MasterMastic

标签： haskell menu io

【解决方案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

【讨论】：