2015-03-21 2 views
3

Я пытаюсь использовать Haskeline, чтобы написать программу, которая запрашивает у пользователя последовательность вопросов, каждая из которых необязательно имеет значение по умолчанию в [скобки] и читает в своих ответах. Я хочу, чтобы пользователь имел возможностьПолучение Haskeline для выхода из игры

  1. Нажмите Enter, чтобы отправить [значение по умолчанию];
  2. Введите строку, отредактируйте ее, если необходимо, а затем нажмите Enter, чтобы отправить это значение;
  3. Нажмите Ctrl-C, чтобы сбросить все значения до значений по умолчанию и начать заново; и
  4. Нажмите Ctrl-D или введите «quit» для выхода, и в этом случае все значения, которые они отправили, будут потеряны.

Я смог получить очки 1-3, но я не могу получить очко 4 для работы: нажатие Ctrl-D (или ввод «выход») просто вызывает следующее приглашение вместо того, чтобы закрыть программу допрос. Посмотрев на мою программу (см. Ниже), я понимаю, почему это происходит, но я не могу понять, как это исправить, так что Ctrl-D (или «quit») фактически останавливает опрос. Как исправить программу, чтобы это произошло?

Я видел this question, который, кажется, спрашивает что-то подобное, но я не мог получить оттуда; Я даже не уверен, что они задают тот же вопрос, что и я.

В качестве второстепенного вопроса: в моей текущей программе есть довольно много заявлений case, которые включают значения Maybe. В частности, я в настоящее время проверяю на Nothing два или три уровня, чтобы я мог правильно вернуть Nothing, когда пользователь нажимает Ctrl-D. У меня такое чувство, что это можно упростить с помощью (что-то вроде) монадического оператора >>=, но я не могу понять, как это сделать в этом случае. Неужели я подозреваю? Есть ли способ покончить со всем этим шаблоном, который ищет Nothing?

Также: скажите мне все, что могло бы улучшить мой код ниже. Я совершенно новичок в этом, поэтому очень вероятно, что я упускаю много очевидных вещей здесь.

Моя программа просит пользователя о составе корзины с фруктами. Информация, связанная с корзиной с фруктами, состоит из имени владельца корзины с фруктами и названий различных видов фруктов в корзине. Чтобы попросить последнего, я сначала попрошу номер различных видов фруктов в корзине, а затем попросите имя каждого вида. Мы начинаем с корзины фруктов по умолчанию, информация о которой затем изменяется в соответствии с тем, что говорит нам пользователь.

module Main where 
import System.Console.Haskeline 

type PersonName = String 
type FruitName = String 
data FruitBasket = FruitBasket { ownerName :: PersonName, 
           fruitCount :: Int, 
           fruitNames :: [FruitName] 
           } deriving Show 

defaultBasket = FruitBasket "Mary" 2 ["Apple", "Peach"] 

main :: IO() 
main = do 
    basket <- getBasketData defaultBasket 
    putStrLn $ "Got: " ++ show(basket) 

-- Prompt the user for information about a fruit basket, and 
-- return a FruitBasket instance containing this information. The 
-- first argument is an instance of FruitBasket from which we get 
-- the default values for the various prompts. The return value 
-- has a Maybe type because the user may abort the questioning, in 
-- which case we get nothing from them. 
getBasketData :: FruitBasket -> IO (Maybe FruitBasket) 
getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket 
    where 
     getData :: FruitBasket -> InputT IO (Maybe FruitBasket) 
     getData initialBasket = handleInterrupt f $ do 
     outputStrLn banner 
     input <- getInputLine $ "Who owns this basket? [" ++ defaultOwner ++ "] : " 
     basket <- case input of 
        Nothing -> return Nothing -- User pressed Ctrl-D with the input being empty 
        Just "" -> return (Just initialBasket) -- User pressed Enter with the input being empty 
        Just "quit" -> return Nothing -- User typed in "quit" and pressed Enter 
        Just newOwner -> return (Just initialBasket{ownerName = newOwner}) 
     input <- getInputLine $ "Number of kinds of fruit in the basket? [" ++ show defaultCount ++ "] : " 
     basket' <- case input of 
        Nothing -> return Nothing 
        Just "" -> return basket 
        Just "quit" -> return Nothing 
        Just count -> return $ updateFruitCount basket (read count) 
          where updateFruitCount Nothing _ = Nothing 
           updateFruitCount (Just realBasket) newCount = Just $ realBasket{fruitCount = newCount} 
     let defaultFruitNames = pruneOrPadNames basket' 
     newNames <- getFruitNames defaultFruitNames 1 
     case newNames of 
      Nothing -> return (Just defaultBasket) 
      Just newSetOfNames -> return $ updateFruitNames basket' newSetOfNames 
       where updateFruitNames Nothing _ = Nothing 
        updateFruitNames (Just realBasket) realNewNames = Just $ realBasket{fruitNames = realNewNames} 
      where f = (outputStrLn "Press Ctrl-D or enter \"quit\" to quit." >> getData initialBasket) 
       defaultOwner = ownerName initialBasket 
       defaultCount = fruitCount initialBasket 


banner :: String 
banner = "Please enter details of the fruit basket below. At each prompt you can do one of the following:\n\ 
     \\t (a) Press Enter to submit the [default] value;\n\ 
     \\t (b) Type in a string, edit it if needed, and then press Enter to submit this value;\n\ 
     \\t (c) Press Ctrl-C to reset all values to the defaults and start over;\n\ 
     \\t (d) Press Ctrl-D or enter \"quit\" to quit; all the values you submitted will be lost." 

pruneOrPadNames :: Maybe FruitBasket -> Maybe [String] 
pruneOrPadNames Nothing = Nothing 
pruneOrPadNames (Just basket) = Just $ pruneOrPad (fruitNames basket) (fruitCount basket) 

-- When requiredLength is not larger than (length inputList), 
-- (pruneOrPad inputList requiredLength) is the prefix of 
-- inputList of length requiredLength. Otherwise, it is inputList 
-- padded with as many empty strings as required to make the total 
-- length equal to requiredLength. 

pruneOrPad :: [String] -> Int -> [String] 
pruneOrPad inputList requiredLength 
       | requiredLength <= inputLength = take requiredLength inputList 
       | otherwise = inputList ++ (replicate difference "") 
    where inputLength = length inputList 
      difference = requiredLength - inputLength 



getFruitNames Nothing _ = return Nothing 
getFruitNames (Just []) _ = return $ Just [""] 
getFruitNames (Just (name:names)) count = do 
    input <- getInputLine $ "Name of fruit " ++ (show count) ++ " [" ++ name ++ "] : " 
    newNames <- case input of 
       Nothing -> return Nothing 
       Just "" -> do -- Keep the default name for this fruit ... 
          newNames' <- getFruitNames (Just names) (count + 1) 
          case newNames' of 
          Nothing -> return Nothing 
          -- ... unless the user chose to quit 
          -- while entering a name 

          Just [""] -> return $ Just [name] 
          -- At this point names = [] so it is 
          -- already time to stop asking for 
          -- more names. 

          Just furtherNames -> return $ Just (name : furtherNames) 

       Just "quit" -> return Nothing 
       Just name' -> do 
          newNames' <- getFruitNames (Just names) (count + 1) 
          case newNames' of 
          Nothing -> return Nothing 
          Just [""] -> return $ Just [name'] 
          Just furtherNames -> return $ Just (name' : furtherNames) 
    return newNames 

ответ

1

Я думаю, что ваша догадка прямо здесь. Большая часть соответствия шаблонов, выполненных с помощью case, может быть заменена на использование Maybe Monad немного больше. Вместо

basket <- case input of 
    Nothing -> return Nothing -- User pressed Ctrl-D with the input being empty 
    Just "" -> return (Just initialBasket) -- User pressed Enter with the input being empty 
    Just "quit" -> return Nothing -- User typed in "quit" and pressed Enter 
    Just newOwner -> return (Just initialBasket{ownerName = newOwner}) 

вы могли бы написать что-то вроде

let basket' = do 
    i <- input 
    guard $ i /= "quit" 
    b <- basket 
    return $ if (null i) then b else b{fruitCount = read i} 

можно даже ввести некоторые помощники как

guardInput :: Maybe String -> (String -> Maybe a) -> Maybe a 
guardInput input λ = input >>= \i -> ((guard $ i /= "quit") >> λ i) 
-- | Custom ternary operator .) 
True ? (a, _) = a 
False ? (_, b) = b 

написать

let basket = guardInput input $ 
     \i -> return $ (null i) ? (initialBasket, initialBasket{ownerName = i}) 

К сожалению - я знаю Тхи s не отвечает на вашу проблему с помощью Ctrl + D, но я не понял, что это сам (пока).

+0

спасибо. Я не очень хорошо знаком с охранниками, поэтому для меня это выглядит как волшебство. Я выяснил вопрос Ctrl-D, а также вопрос факторинга (в некоторой степени), пожалуйста, см. Мой ответ. –

+0

Хорошо, приятно видеть, что вы нашли решение :) –

2

С помощью некоторых советов here on the haskell-beginners mailing list Мне удалось решить мои проблемы, вопрос Ctrl-D полностью и факторинговый вопрос, к моему собственному удовлетворению (на данный момент!). Я отправляю ответ здесь, надеясь, что он поможет другим в моем затруднительном положении.

Во-первых, проблема с Ctrl-D: Проблема заключалась в том, что я выбрасывая логикууправления, предлагаемые Может монады и просто используя значения из монады, ссылаясь на различные имена переменных, которые содержали эти значения. Первое место, где я делаю это здесь, в функции getBasketData:

basket <- case input of ...    
input <- getInputLine ... 
basket' <- case input of 
       Nothing -> return Nothing 
       Just "" -> return basket 

Обратите внимание, как, в вычислениях basket', я

  1. игнорировать тот случай, когда basket могло быть Nothing и
  2. Используйте значение , инкапсулированное basket, ссылаясь на (и сопоставление шаблонов на, если необходимо) переменную basket, которая по-прежнему находится в области внутри выражения для basket'.

Это то место, где был утерян Ctrl-D. Здесь, напротив, код getBasketData, который делает не пусть Nothing сек проскользнуть через пробелы (я переименовал basket переменные maybeBasket, потому что они действительно случаи Maybe FruitBasket):

getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket 
    where 
     getData :: FruitBasket -> InputT IO (Maybe FruitBasket) 
     getData initialBasket = handleInterrupt f $ do 
      outputStrLn banner 
      input <- getInputLine $ "Who owns this basket? [" ++ defaultOwner ++ "] : " 
      maybeBasket <- case input of 
         Nothing -> return $ Nothing -- User pressed Ctrl-D with the input being empty 
         Just "" -> return $ Just initialBasket -- User pressed Enter with the input being empty 
         Just "quit" -> return $ Nothing -- User typed in "quit" and pressed Enter 
         Just newOwner -> return $ Just initialBasket{ownerName = newOwner} 
      maybeBasket' <- case maybeBasket of 
         Nothing -> return $ Nothing 
         Just realBasket -> do input <- getInputLine $ "Number of kinds of fruit in the basket? [" ++ show defaultCount ++ "] : " 
               case input of 
               Nothing -> return $ Nothing 
               Just "" -> return $ maybeBasket 
               Just "quit" -> return $ Nothing 
               Just count -> return $ Just $ realBasket{fruitCount = (read count)} 
      maybeBasket'' <- case maybeBasket' of 
           Nothing -> return $ Nothing 
           Just realBasket -> do let defaultFruitNames = pruneOrPad (fruitNames realBasket) (fruitCount realBasket) 
                newNames <- getFruitNames defaultFruitNames 1 
                case newNames of 
                 Nothing -> return $ Nothing 
                 Just newSetOfNames -> return $ Just $ realBasket{fruitNames = newSetOfNames} 
      return maybeBasket'' 
       where f = (outputStrLn interruptMessage >> getData initialBasket) 
        defaultOwner = ownerName initialBasket 
        defaultCount = fruitCount initialBasket 

Таким образом, для Например, мы пытаемся сделать любые реальные вычисления, чтобы получить maybeBasket' --- включая, представляя приглашение для количества различных видов фруктов --- только если maybeBasket не Nothing.

Это решает проблему Ctrl-D: программа перестает опросить и возвращает Nothing, если пользователь нажимает Ctrl-D в ответ на любой вопрос.


Теперь на факторинг. Вот почему советы из списка рассылки помогли: я начал с разбивки большой функции getData на три части, по одному для каждого «большого» использования оператора <-, и поместил эти части в отдельные функции. Это значительно облегчило логику для меня (действительно, так я нашел исправление для проблемы Ctrl-D).Начиная с этого, я продолжал перефразировать различные части, пока не получил следующую версию, которая выглядит достаточно хорошо для меня. Обратите внимание, как маленькая и чистая функция getBasketData стала!

module Main where 
import System.Console.Haskeline 

type PersonName = String 
type FruitName = String 
data FruitBasket = FruitBasket { ownerName :: PersonName, 
           fruitCount :: Int, 
           fruitNames :: [FruitName] 
           } deriving Show 

defaultBasket :: FruitBasket 
defaultBasket = FruitBasket "Mary" 2 ["Apple", "Peach"] 

main :: IO() 
main = do 
    basket <- getBasketData defaultBasket 
    putStrLn $ "Got: " ++ show(basket) 

-- Prompt the user for information about a fruit basket, and 
-- return a FruitBasket instance containing this information. The 
-- first argument is an instance of FruitBasket from which we get 
-- the default values for the various prompts. The return value 
-- has a Maybe type because the user may abort the questioning, in 
-- which case we get nothing from them. 
getBasketData :: FruitBasket -> IO (Maybe FruitBasket) 
getBasketData basket = runInputT defaultSettings $ withInterrupt $ getData basket 
    where 
     getData :: FruitBasket -> InputT IO (Maybe FruitBasket) 
     getData initialBasket = handleInterrupt f $ do 
      outputStrLn banner 
      (ownerQ initialBasket) >>= (processOwner initialBasket) >>= processCount >>= processNames 
       where f = (outputStrLn interruptMessage >> getData initialBasket) 


ownerQ :: FruitBasket -> InputT IO (Maybe PersonName) 
ownerQ basket = getInputLine $ "Who owns this basket? [" ++ (ownerName basket) ++ "] : " 


processOwner :: FruitBasket -> Maybe PersonName -> InputT IO (Maybe FruitBasket) 
processOwner _ Nothing = return Nothing 
processOwner _ (Just "quit") = return Nothing 
processOwner basket (Just "") = return $ Just basket 
processOwner basket (Just newOwner) = return $ Just basket{ownerName = newOwner} 


processCount :: Maybe FruitBasket -> InputT IO (Maybe FruitBasket) 
processCount Nothing = return Nothing 
processCount (Just basket) = (fruitTypesQ basket) >>= processCount' 
    where processCount' :: Maybe String -> InputT IO (Maybe FruitBasket) 
     processCount' Nothing = return Nothing 
     processCount' (Just "quit") = return Nothing 
     processCount' (Just "") = return $ Just basket 
     processCount' (Just count) = return $ Just basket{fruitCount = (read count)} 


fruitTypesQ :: FruitBasket -> InputT IO (Maybe String)   
fruitTypesQ basket = getInputLine $ "Number of kinds of fruit in the basket? [" ++ show (fruitCount basket) ++ "] : " 


processNames :: Maybe FruitBasket -> InputT IO (Maybe FruitBasket) 
processNames Nothing = return Nothing 
processNames (Just basket) = input >>= processNames' 
    where input = getFruitNames defaultFruitNames 1 
     defaultFruitNames = pruneOrPad (fruitNames basket) (fruitCount basket) 
     processNames' :: Maybe [FruitName] -> InputT IO (Maybe FruitBasket) 
     processNames' Nothing = return Nothing 
     processNames' (Just newSetOfNames) = return $ Just basket{fruitNames = newSetOfNames} 



banner :: String 
banner = "Please enter details of the fruit basket below. At each prompt you can do one of the following:\n\ 
     \\t (a) Press Enter to submit the [default] value;\n\ 
     \\t (b) Type in a string, edit it if needed, and then press Enter to submit this value;\n\ 
     \\t (c) Press Ctrl-C to reset all values to the defaults and start over;\n\ 
     \\t (d) Press Ctrl-D or enter \"quit\" to quit; all the values you submitted will be lost." 

interruptMessage :: String 
interruptMessage = "#################################################\n\ 
        \You pressed Ctrl-C.\n\ 
        \We will now reset all values and start over.\n\ 
        \To quit, press Ctrl-D or enter \"quit\".\n\ 
        \#################################################\n" 




pruneOrPadNames :: Maybe FruitBasket -> Maybe [String] 
pruneOrPadNames Nothing = Nothing 
pruneOrPadNames (Just basket) = Just $ pruneOrPad (fruitNames basket) (fruitCount basket) 

-- When requiredLength is not larger than (length inputList), 
-- (pruneOrPad inputList requiredLength) is the prefix of 
-- inputList of length requiredLength. Otherwise, it is inputList 
-- padded with as many empty strings as required to make the total 
-- length equal to requiredLength. 

pruneOrPad :: [String] -> Int -> [String] 
pruneOrPad inputList requiredLength 
       | requiredLength <= inputLength = take requiredLength inputList 
       | otherwise = inputList ++ (replicate difference "") 
    where inputLength = length inputList 
      difference = requiredLength - inputLength 


getFruitNames :: [FruitName] -> Int -> InputT IO (Maybe [FruitName]) 
getFruitNames [] _ = return $ Just [""] 
getFruitNames (name:names) count = do 
    input <- getInputLine $ "Name of fruit " ++ (show count) ++ " [" ++ name ++ "] : " 
    newNames <- case input of 
       Nothing -> return Nothing 
       Just "" -> do -- Keep the default name for this fruit ... 
          newNames' <- getFruitNames names (count + 1) 
          case newNames' of 
          Nothing -> return Nothing 
          -- ... unless the user chose to quit 
          -- while entering a name 

          Just [""] -> return $ Just [name] 
          -- At this point names = [] so it is 
          -- already time to stop asking for 
          -- more names. 

          Just furtherNames -> return $ Just (name : furtherNames) 

       Just "quit" -> return Nothing 
       Just name' -> do 
          newNames' <- getFruitNames names (count + 1) 
          case newNames' of 
          Nothing -> return Nothing 
          Just [""] -> return $ Just [name'] 
          Just furtherNames -> return $ Just (name' : furtherNames) 
    return newNames 

Мораль этой истории, кажется: «Когда спутать, ломать вещи вниз.»

+1

Я бы экспериментировал с использованием ['MaybeT'] (http://hackage.haskell.org/package/transformers-0.4.3.0/docs/Control- Monad-Trans-Maybe.html # g: 1) monad transformer, который может упростить многие из ваших вложенных «case somethingMaybe ...». Ваш 'InputT IO (возможно, FruitBasket)' вместо этого будет 'MaybeT (InputT IO) FruitBasket'. – adamse

Смежные вопросы