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を探しています。

あなたがそれを使用する方法の例：（！あるいは同等のワンライナーdeletedb = liftIO . removeFile =<< getFile =<< getName）

import Control.Monad.Except 

data ExitType = ToMenu | Error String 

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

を

次に、あなたは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