import Maybe

data Question = Free String | Choice String [String]
data Answer = FreeAnswer String | ChoiceAnswer Int
 deriving Show

questionary :: [Question] -> IO [Answer]
questionary = mapM ask

ask :: Question -> IO Answer
ask (Free s) = putStr (s++": ") >> getLine >>= return . FreeAnswer
ask (Choice s cs) = askIndex >>= return . ChoiceAnswer
 where
  askIndex = putStr question >> 
             getLine >>= return . readIndex >>= 
             maybe (putStrLn complaint >> askIndex) return

  question = s ++ " (" ++ foldr1 (\x y -> x++"/"++y) 
                           (map (\ (n,c) -> show n++"."++c) (zip [1..] cs)) ++
                   "): "

  readIndex s
    = case reads s of
       [(n,"")] -> if 1 <= n && n <= length cs then Just n else Nothing
       _ -> Nothing

  complaint = "Bitte geben Sie eine Zahl zwischen 1 und " ++ 
              show (length cs) ++ " ein!"

main = questionary [Free "Name"
                   ,Choice "Geschlecht" ["weiblich","maennlich"]]
   >>= print