+{-# LANGUAGE TupleSections #-}
+
+module Prompts
+ ( textPrompt, yornPrompt, dependantPrompt
+ ) where
+
+import System.IO
+import Data.Char (toLower)
+import Control.Monad (join)
+
+isEmpty :: String -> Bool
+isEmpty = (== "")
+
+cannotBeEmpty :: String -> Either String String
+cannotBeEmpty xs = case isEmpty xs of
+ True -> Left "Value cannot be empty"
+ False -> Right xs
+
+prompt :: String -> (String -> Either String a) -> IO a
+prompt xs validate = do
+ putStrLn xs
+ response <- getLine
+ case validate response of
+ Left error -> putStrLn error >> prompt xs validate
+ Right result -> return result
+
+subPrompt :: String -> (String -> Bool) -> IO a -> IO (Maybe (String, a))
+subPrompt xs showNext p = do
+ let v x = case showNext x of
+ True -> Right $ p >>= return . Just . (x ,)
+ False -> Right $ return Nothing
+
+ join $ prompt xs v
+
+textPrompt :: String -> IO String
+textPrompt xs = prompt xs cannotBeEmpty
+
+dependantPrompt :: String -> String -> IO (Maybe (String,String))
+dependantPrompt xs1 xs2 = subPrompt xs1 (not . isEmpty) $ prompt xs2 cannotBeEmpty
+
+yornPrompt :: String -> IO Bool
+yornPrompt xs = do
+ let v x = case (map toLower x) of
+ "y" -> Right True
+ "n" -> Right False
+ _ -> Left "Please answer with y or n"
+ prompt (xs ++ " (y/n):") v