使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