Fellow Haskellers, I've been working on a library designed to make building simple line-based command line scripts easy and straightforward for some time now. To that end, before I release it I'd like feedback on the code and its design. I've pasted the library below. Unfortunately I had to leave off the documentation and QuickCheck properties as they went over the size limit. Some simple programs that can be built using the library include guess a number (use as "play_game guess_num_fun"): guess_num_fun = do target <- reqIO $ getStdRandom (randomR (1::Integer,100)) let guessed val = case compare target val of GT -> do { reqIO $ putStrLn "Too low!"; return False } LT -> do { reqIO $ putStrLn "Too high!"; return False } EQ -> do { reqIO $ putStrLn "You win!"; return True } reqUntil guessed (prompt "Enter a number between 1 and 100: " reqInteger) play_game game = execReq game Or the ability to collect structured values (use with "getTaxpayer reqTaxpayerEasy") data Taxpayer = Taxpayer { name :: String, age :: Int, ssn :: String } deriving (Read, Show) reqTaxpayerEasy :: Request Taxpayer reqTaxpayerEasy = do name <- prompt "Please enter the tax payer's name: " reqResp age <- prompt "Please enter their age: " reqInt ssn <- prompt "What is their SSN/ASN: " reqResp return (Taxpayer name age ssn) getTaxpayer which = execReq $ do peon <- which reqIO $ putStrLn $ "You entered: " ++ show peon You can also build simple menus (use with "pim"): topMenu = reqMenu $ ("Manage contacts", reqCont manageContactsMenu topMenu) : ("Manage calendar", reqCont manageCalendarMenu topMenu) : [] manageContactsMenu = reqMenu $ ("Add a contact", undefined) : ("Remove a contact", undefined) : ("Return to previous menu", reqFail) :[] manageCalendarMenu = reqMenu $ ("Add an event", undefined) : ("Remove an event", undefined) : ("List events", undefined) : ("Return to previous menu", reqFail) : [] pim = execReq $ reqForever topMenu Except for the examples above, this email is literate haskell if anyone wishes to play with the code. Thanks in advance for any and all feedback! Feel free to contact me if you'd like more examples or the "real" file. Justin --- cut here ---- \begin{code} module HCL ( -- * Request type and related functions. Request, runRequest, execReq, reqIO, makeReq, -- * Request building blocks reqResp, reqInteger, reqInt, reqRead, -- * Functions lifted into Requests andReq, orReq, notReq, reqIf, reqConst, reqLift, reqLift2, reqMaybe, -- * Higher-level Request combinators reqAgree, reqFail, required, reqUntil, reqWhile, reqDefault, reqForever, reqChoices, reqMenu, reqIterate, reqCont, reqWhich, reqFoldl, reqList, -- * Prompting prompt, promptWithDefault, promptAgree ) where import Data.Char (isSpace, toLower, isPrint) import System.IO (hFlush, stdout) import Test.QuickCheck import System.IO.Unsafe (unsafePerformIO) import System.Random import Data.Maybe (isNothing, isJust) {- | The Request data type represents a value requested interactively. The request may have failed or been no response, in which case the request fails. Otherwise, the request holds the response given. -} data Request a = Request (IO (Maybe a)) {- | Runs a request, throws away the result, and returns an IO type (rather than a Request). Useful when a request should just be run and we don't care about the result. Generally used at the top level to evaluate a request in main. -} execReq :: Request a -- ^ Request to run. -> IO () -- ^ No meaningful value is returned. execReq (Request req) = do result <- req maybe (return ()) (\_ -> return ()) result -- | Extracts the value from a given request. runRequest :: Request a -- ^ The request to evaluate. -> IO (Maybe a) -- ^ Result of the request. runRequest (Request r) = r {- | Allows IO operations in the Request type. Same as liftIO in MonadIO class (in Control.Monad.Trans module) -} reqIO :: IO a -- ^ IO action to perform -> Request a -- ^ Result of the IO action, as a Request. reqIO io = Request ioVal where ioVal = do val <- io return $ Just val {- | Request behavior as a Monad covers failure - when a request results in Nothing, all bind operations fail afterwards. Thus, when one request fails, all subsequent requests automatically fail. -} instance Monad Request where return x = makeReq x f >>= g = f `andMaybe` g {- | Takes a value and makes it into a request. Should not be an IO (Maybe a) type value, unless multiply nested values is desired. -} makeReq :: a -- ^ The value to turn into a Request. -> Request a -- ^ The value as a Request. makeReq val = Request (return $ Just val) {- | If the request given results in Nothing, Nothing is returned. Otherwise, the value held in the Just constructor is passed to the "next" function given. This is essentially the bind operation. -} andMaybe :: Request a -- ^ Request to try. -> (a -> Request b) -- ^ Function which processes the result of the previous request and returns a new request. -> Request b -- ^ The new request returned. andMaybe (Request req) next = Request $ do v <- req case v of Nothing -> return Nothing Just x -> nextReqVal where Request nextReqVal = next x {- | The basic request - get a string from the user. If a newline or all whitespace is entered, the request is assumed to be a failure. -} -- Read a string from the user. reqResp :: Request String reqResp = Request $ do val <- getLine if all isSpace val then return Nothing else return $ Just val {- | Gets an Integer from the user. If the value entered cannot be converted, the request fails. -} reqInteger :: Request Integer reqInteger = reqRead reqResp {- | Gets an Int from the user. If the value entered cannot be converted, the request fails. -} reqInt :: Request Int reqInt = reqRead reqResp {- | Uses reads to process a request. If the value cannot be parsed, fails. Otherwise, returns the value parsed. -} reqRead :: (Read a) => Request String -- ^ A request that returns a string (generally 'reqResp'), which will then be parsed. -> Request a -- ^ The value parsed. reqRead req = req `andMaybe` \val -> Request $ do case reads val of [] -> return Nothing ((v, _):[]) -> return $ Just v _ -> return Nothing {- | && operator for requests (with failure). Behaves similarly, including "short-circuit" behavior. If either condition fails, the entire Request fails. -} andReq :: Request Bool -- ^ Left boolean value. -> Request Bool -- ^ Right boolean value. -> Request Bool -- ^ Result value. andReq left right = left `andMaybe` \lb -> Request $ case lb of False -> return $ Just False True -> runRequest right {- | || operator for requests (with failure). Behaves similarly, including "short-circuit" behavior. If either condition fails, the entire Request fails. -} orReq :: Request Bool -- ^ Left boolean value. -> Request Bool -- ^ Right boolean value. -> Request Bool -- ^ Result value. orReq left right = left `andMaybe` \lb -> Request $ case lb of True -> return (Just True) False -> runRequest right -- | not operator for requests. notReq :: Request Bool -- ^ Request to evaluate. -> Request Bool -- ^ Result value. notReq expr = expr `andMaybe` \nb -> Request $ return (Just $ not nb) -- | If statement for requests. reqIf :: Request Bool -- ^ The test to apply -> Request a -- ^ Request to evaluate if test is true. -> Request a -- ^ Request to evaluate if test if false. -> Request a -- ^ Result. reqIf test thenCase elseCase = test `andMaybe` \tb -> if tb then thenCase else elseCase -- | Takes a value and makes it into a request. reqConst :: a -- ^ Value to make into a request. -> Request a -- ^ Result. reqConst val = return val -- | Lifts a one-argument function into Request types. reqLift :: (a -> b) -- ^ Function to lift. -> Request a -- ^ Argument to function. -> Request b -- ^ Result. reqLift f req = do reqVal <- req return (f reqVal) {- | Lifts a 2 argument function into Request types. The arguments to the function are evaluated in order, from left to right, since the Request monad imposes sequencing. -} reqLift2 :: (a -> b -> c) -- ^ Function to lift. -> Request a -- ^ First argument to function. -> Request b -- ^ Second argument to function. -> Request c -- ^ Result. reqLift2 f left right = do leftVal <- left rightVal <- right return (f leftVal rightVal) {- | Returns true if the user answer y or Y. Allows a default to be specified, and allows failure if no default is given. -} reqAgree :: Maybe Bool -- ^ Default value (if any). -> Request String -- ^ Request which gets a string (usually reqResp). -> Request Bool -- ^ Result. reqAgree def req = Request result where Request result = reqMaybe req (Request returnDefault) (Request . returnAgreement) returnDefault = return $ maybe Nothing (\d -> Just d) def returnAgreement resp = case clean resp of ('y':_) -> return $ Just True ('n':_) -> return $ Just False _ -> returnDefault clean = (map toLower) . filter (not . isSpace) -- | Automatic failure. Useful in menus to quit or return to the previous menu. reqFail :: Request a reqFail = Request $ return Nothing {- | Takes a request and guarantees a value will be returned. That is, the request is repeated until a valid (i.e. not Nothing) response is returned. -} required :: Request a -- ^ Request to evaluate. -> Request a -- ^ Result. required (Request req) = Request required' where required' = do val <- req case val of Nothing -> required' Just v -> return (Just v) {- | Like the maybe function, but for requests. Given a request value, a default value,and a function that maps b to Request a, this function either returns the default if the request value is nothing, or it applies the function given to the value of the request and returns it. -} reqMaybe :: Request a -- ^ Request to evaluate. -> Request b -- ^ Default value. -> (a -> Request b) -- ^ Function to map b to Request a. -> Request b -- ^ Result. reqMaybe (Request req) (Request def) fun = Request $ do val <- req case val of Nothing -> def Just v -> nextReqVal where Request nextReqVal = fun v {- | Runs the request while the condition given holds, then returns the result. Good for verification. -} reqWhile :: (a -> Request Bool) -> Request a -> Request a reqWhile cond req = do reqVal <- req testVal <- cond reqVal if testVal then reqWhile cond req else return reqVal {- | Runs the request until the condition given is satisfied, then returns the result. -} reqUntil :: (a -> Request Bool) -- ^ Condition to test. -> Request a -- ^ Request value to evaluate according to test. -> Request a -- ^ Result. reqUntil cond req = reqWhile ((reqLift not) . cond) req {- | Requests a response from user. If Nothing is returned, assumes default and returns that. -} reqDefault :: Request a -- ^ Request to evaluate. -> a -- ^ Default value. -> Request a -- ^ Result. reqDefault req def = Request $ do val <- runRequest req case val of Nothing -> return $ Just def v -> return v -- Ask a request forever (or until failure). reqForever :: Request a -- ^ Request to ask forever. -> Request a -- ^ Result. reqForever req = req `andMaybe` \_ -> reqForever req {- | Given a list of items and programs to run, displays a menu of the items and runs the selected program. Very low level - usually reqMenu is used instead. If the user selects an invalid choice, failure occurs. -} reqChoices :: [(String, a)] -- ^ List of choices and labels which will be selected from. -> Request Int -- ^ Request which gets the selection from the user. -> Request a -- ^ Result of selection. reqChoices choices req = do let choiceCnt = length choices choiceList = zip [(1::Int)..] (map (\(label, _) -> label) choices) sequence (map (\(idx, label) -> reqIO $ putStrLn ((show idx) ++ ". " ++ label)) choiceList) idx <- prompt "? " req if idx < 1 || idx > length choices then reqFail else return (snd (choices !! (idx - 1))) -- | Takes a list of strings and requests and forms a menu out of them. Usually used over reqChoices. reqMenu :: [(String, Request a)] -- ^ List of request choices and labels. -> Request a -- ^ Result. reqMenu choices = do choice <- reqChoices choices reqInt choice {- | Takes an initial value and function which produces a request from that value. Applies the function to the initial value and then recurses. Useful for functions which operate off their own output (e.g. a shell maintaining an environment). -} reqIterate :: (a -> Request a) -- ^ Iterative function which transforms a to Request a. -> a -- ^ Initial value used. -> Request a -- ^ Result of evaulation. reqIterate fn initial = do result <- fn initial reqIterate fn result {- | Takes a request and a "continuation" request. If the first request results in Nothing, run the second request. In either case, return the result of the successful request. -} reqCont :: Request a -- ^ First request to evaluate. -> Request a -- ^ Continuation request which is evaluated if first fails. -> Request a -- ^ Result. reqCont req cont = do result <- reqWhich req case result of Left _ -> cont Right val -> return val {- Indicates if the request failed or succceeded. If Left () is returned, the request failed. If Right v is returned, the request produce a value. Though the value returned is itself a request, it will always be valid. -} reqWhich :: Request a -- ^ Request to evaluate. -> Request (Either () a) -- ^ Result. reqWhich req = do let -- default value, indicating a bad selection was made. failed = Request (return (Just (Left ()))) -- Indicates a valid item was selected. success val = Request (return (Just (Right val))) reqMaybe req failed success {- | Give a function from a -> b, an initial value, and a Request for a, builds a Request for b. When (Request a) fails, then the function returns whatever (Request b) has been built. -} reqFoldl :: (a -> b -> Request b) -- ^ Accumulating function. -> b -- ^ Initial value. -> Request a -- ^ Request to evaluate. -> Request b -- ^ Result. reqFoldl fn initial req = reqFoldl' initial where reqFoldl' acc = do result <- reqWhich req case result of Left _ -> return acc Right val -> do result <- fn val acc reqFoldl' result {- | Given a request, builds a list of response. When the user enters nothing, the list building ends -} reqList :: Request a -- ^ Request to evaluate. -> Request [a] -- ^ Result. reqList req = reqFoldl (\l ls -> return (l:ls)) [] req {- | Prints a message and makes a request. If the message ends in a space, it is assumed that the user should enter values on the same line. Otherwise, a new line is printed and the reqeust is evaulated. -} prompt :: String -- ^ Message to display. -> Request a -- ^ Request which gathers input -> Request a -- ^ Result. prompt msg (Request req) = Request $ do if isSpace (last msg) then putStr msg else putStrLn msg hFlush stdout val <- req return val {- | Displays a message prompt and a default choice in a common way. If the user doesn't provide a choice or enters bad data, the default value provided is returned. Otherwise, the value entered is returned. -} promptWithDefault :: (Show a) => String -- ^ Message to display. Follows conventions of 'prompt'. -> Request a -- ^ Request to evaluate. -> a -- ^ Default value to use if necessary. -> Request a -- ^ Result. promptWithDefault msg req def = let msgWithDefault = msg ++ " [" ++ show def ++ "] " in prompt msgWithDefault (reqDefault req def) {- | Prints a message, displays defaults (if any), and turns a Request String into a Request Bool. If a default value is provided, it will be returned if the user enters nothing or an invalid response. -} promptAgree :: String -- ^ Message to display. Follows conventions of 'prompt'. -> Maybe Bool -- ^ Default value, if any. -> Request String -- ^ Request which gets a string (usually reqResp). -> Request Bool -- ^ Result. promptAgree msg def req = prompt msgWithDefault (reqAgree def req) where msgWithDefault = maybe msg (\v -> if v then (msg ++ "(Y/n) ") else (msg ++ "(y/N) ")) def \end{code}