[Haskell-cafe] Getting Haskeline to quit early

22 Mar 2015

      (I posted this to Stack Overflow [1], but no luck there so far.)

Hi all,

I am trying to use Haskeline [2] to write a program which asks the user
a sequence of questions, each one optionally with a default value in
[brackets], and reads in their responses. I want the user to be able to

1. Press Enter to submit the [default] value;
2. Type in a string, edit it if needed, and then press Enter to submit
this value;
3. Press Ctrl-C to reset all values to the defaults and start over; and,
4. Press Ctrl-D or enter "quit" to quit, in which case all the values
which they  submitted are lost.

I have been able to get points 1-3 working, but I cannot get point 4 to
work: pressing Ctrl-D (or entering "quit") just brings up the next
prompt instead of making the program quit the questioning. Looking at my
program (please see below) I understand why this happens, but I am not
able to figure out how to fix this so that Ctrl-D (or "quit") actually
makes the questioning stop. How do I fix the program to make this
happen?

I did see this question [2] over at Stack Overflow which seems to ask
something similar, but I could not get much from there; I am not even
sure that they are asking the same question as I am.

As a secondary question: my current program has quite a few `case`
statements which switch on `Maybe` values. In particular, I currently
check for `Nothing` two or three levels deep so that I can correctly
return a `Nothing` when the user presses Ctrl-D. I have a feeling that
this could be simplified using (something like) the monadic `>>=`
operator, but I am unable to figure out how to do this in this case. Is
my hunch right? Is there a way to do away with all this pattern 
matching which looks for `Nothing`?

Also: please tell me anything else which could improve my code below. I
am quite new to this, so it is very likely that I am missing many
obvious things here.

Thanks in advance!

Regards,
Philip
----------------

The program
---------------

My program asks the user about the composition of a fruit basket. The
information associated with a fruit basket consists of the name of the
owner of the fruit basket and the names of the different kinds of fruit
in the basket. To be able to ask for the latter, I first ask for the
_number_ of different kind of fruit in the basket, and then ask for the
name of each kind. We start with a default fruit basket whose
information is then modified based on what the user tells us. 

    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

References
-------------

[1]
http://stackoverflow.com/questions/29189428/getting-haskeline-to-quit-early
[2]:
https://hackage.haskell.org/package/haskeline-0.7.1.3/docs/System-Console-Ha...
[3]:
http://stackoverflow.com/questions/4771199/haskell-best-practise-early-termi...

[Haskell-cafe] Getting Haskeline to quit early

G Philip