import IOutilities(getCookedLine, trim)

{-
   retrieve from the keyboard a line containing a string
   from an expected set of possibilities, interpret it
   via a supplied conversion function (classFromString);
   reject and re-prompt if isValidClass delivers False when
   applied to the entered string
-}  

getClass :: (Eq a, Show a) =>
            String -> (String -> Bool) -> (String -> a) -> IO(a)
getClass prompt isValidClass classFromString =
  do
    putStr prompt
    response <- getCookedLine
    do
      let sr = (map toLower . trim) response
      if (isValidClass sr)
        then return(classFromString sr)
        else
          do
            putStr "Response not understood ... "
            getClass prompt isValidClass classFromString

-- Examples using getClass:

data MaleFemale = Male | Female
   deriving (Eq, Show)

getMaleFemale :: IO(MaleFemale)
getMaleFemale =
  getClass "Enter Male or Female: "
           (`elem` ["m", "f", "male", "female"])
           maleFemaleFromString

maleFemaleFromString s
  | head s == 'm'   = Male
  | otherwise      = Female

tstmf =
  do
    rsp <- getMaleFemale
    putStr(show rsp)


data OS = Windows | Windows95 | Linux
   deriving (Eq, Show, Ord)

getOS :: IO(OS)
getOS = getClass ("\nEnter Operating System\n" ++
                  "     Windows, Windows95, or Linux: ")
                 (`elem` ["windows", "windows95", "95", "linux", "l"])
                 osFromString
            
osFromString :: String -> OS
osFromString s
  | s == "windows"                 = Windows
  | s `elem` ["windows95", "95"]   = Windows95
  | otherwise                      = Linux

tstos =
  do
    rsp <- getOS
    putStr(show rsp)

--  retrieve a list of responses from the keybard

getListOfResponses :: [String] -> IO(Maybe r) -> IO[r]
getListOfResponses (prompt : prompts) getResponse =
  do
    putStr prompt
    maybeResponse <- getResponse
    responses <- getList prompts getResponse maybeResponse
    return responses

getList :: [String] -> IO(Maybe r) -> Maybe r -> IO[r]
getList _ _ Nothing = return[ ]
getList prompts getResponse (Just response) =
  do
    responses <- getListOfResponses prompts getResponse
    return([response] ++ responses)


-- Example using getListOfResponses and getClass:

data ABC = A | B | C
  deriving (Eq, Ord, Show)

getABCs :: IO[ABC]
getABCs = getListOfResponses abcPrompts getABC

getABC :: IO(Maybe ABC)
getABC =
  getClass "Enter A, B, or C (or empty line to stop): "
           (`elem` ["a", "b", "c", ""])
           maybeABCfromString

maybeABCfromString :: String -> Maybe ABC
maybeABCfromString = abc . map toLower
  where
  abc "a" = Just A
  abc "b" = Just B
  abc "c" = Just C
  abc ""  = Nothing

abcPrompts :: [String]
abcPrompts =  map ((++ ". ") . show) [1 ..]

tstabc =
  do
    responses <- getABCs
    putStr("responses = " ++ show responses)