Question

我正在尝试创建一个允许用户操作数据库（文本文件）的程序。

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

有没有办法可以轻松地将其分开以使我的代码更紧凑？我尝试在菜单中执行此部分，并且选择函数的类型为

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

使io程序更加模块化

1 个答案: