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