diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Liam O'Connor-Davis + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Liam O'Connor-Davis nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Console/Wizard.hs b/System/Console/Wizard.hs new file mode 100644 --- /dev/null +++ b/System/Console/Wizard.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, Trustworthy, MultiParamTypeClasses, FlexibleInstances #-} +module System.Console.Wizard + ( -- * Wizards + -- $intro + Wizard (..) + , PromptString (..) + -- * Primitives + -- $primitives + , line + , linePrewritten + , password + , character + , output + , outputLn + -- * Modifiers + -- $modifiers + , retry + , retryMsg + , defaultTo + , parser + , validator + -- * Convenience + , nonEmpty + , inRange + , parseRead + -- * Utility + , liftMaybe + , ensure + , readP + ) where + +import System.Console.Wizard.Internal +import Control.Applicative +import Control.Monad.Trans.Maybe +import Control.Monad.Reader +import Control.Monad.Prompt +import Data.Maybe + +-- | A @Wizard a@ is a conversation with the user that will result in a data type @a@, or may fail. +-- A 'Wizard' is made up of one or more \"primitives\" (see below), composed using the 'Applicative', +-- 'Monad' and 'Alternative' instances. The 'Alternative' instance is, as you might expect, a maybe-style cascade. +-- If the first wizard fails, the next one is tried. +-- +-- The 'Wizard' constructor is exported here for use when developing backends, but it is better for end-users to +-- simply pretend that 'Wizard' is an opaque data type. Don't depend on this unless you have no other choice. +-- +-- 'Wizard's are, internally, just a maybe transformer over a prompt monad for each primitive action. +newtype Wizard backend a = Wizard (MaybeT (RecPrompt (WizardAction backend)) a) + deriving (Monad, Functor, Applicative, Alternative, MonadPlus) +instance MonadPrompt (WizardAction s (RecPrompt (WizardAction s))) (Wizard s) where + prompt = Wizard . lift . prompt + + + +-- $primitives +-- /Primitives/ are the basic building blocks for @wizards@. Use these functions to produce wizards that +-- ask for input from the user, or output information. + +-- | Read one line of input from the user. +line :: PromptString -> Wizard b String +line str = prompt $ Line str + +-- | Read one line of input, with some default text already present, before and/or after the editing cursor. +-- Backends are not required to display this default text, or position the cursor anywhere, it is merely +-- a suggestion. +linePrewritten :: PromptString + -> String -- ^ Text to the left of the cursor + -> String -- ^ Text to the right of the cursor + -> Wizard b String +linePrewritten p s1 s2 = prompt $ LinePreset p s1 s2 + +-- | Read one line of password input, with an optional mask character. +-- The exact masking behavior of the password may vary from backend to backend. The masking character +-- does not have to be honoured. +password :: PromptString + -> Maybe Char -- ^ Mask character, if any. + -> Wizard b String +password str m = prompt $ Password str m + +-- | Read a single character only from input. +character :: PromptString -> Wizard b Char +character = prompt . Character + +-- | Output a string, if the backend used supports output. +output :: String -> Wizard b () +output = prompt . Output + +-- | Output a string followed by a newline, if the backend used supports such output. +outputLn :: String -> Wizard b () +outputLn = prompt . OutputLn + +-- $modifiers +-- /Modifiers/ change the behaviour of existing wizards. + +-- | Retry produces a wizard that will retry the entire conversation again if it fails. +-- Conceptually, it could thought of as @retry x = x \<|\> retry x@, however it also prints +-- a user-friendly error message in the event of failure. +retry :: Wizard b a -> Wizard b a +retry = retryMsg "Invalid input. Please try again." + +-- | Same as 'retry', except the error message can be specified. +retryMsg :: String -> Wizard b a -> Wizard b a +retryMsg msg x = x <|> (outputLn msg >> retryMsg msg x) + +-- | @x \`defaultTo\` y@ will return @y@ if @x@ fails, e.g @parseRead line \`defaultTo\` 0@. +defaultTo :: Wizard b a -> a -> Wizard b a +defaultTo wz d = wz <|> pure d + +-- | Like 'fmap', except the function may be partial ('Nothing' causes the wizard to fail). +parser :: (a -> Maybe c) -> Wizard b a -> Wizard b c +parser f a = a >>= liftMaybe . f + +-- | @validator p w@ causes a wizard to fail if the output value does not satisfy the predicate @p@. +validator :: (a -> Bool) -> Wizard b a -> Wizard b a +validator = parser . ensure + +-- | Simply @validator (not . null)@, makes a wizard fail if it gets an empty string. +nonEmpty :: Wizard b [a] -> Wizard b [a] +nonEmpty = validator (not . null) + +-- | Makes a wizard fail if it gets an ordered quantity outside of the given range. +inRange :: (Ord a) => (a,a) -> Wizard b a -> Wizard b a +inRange (b,t) = validator (\x -> b <= x && x <= t) + +-- | Simply @parser readP@. Attaches a simple @read@ parser to a 'Wizard'. +parseRead :: (Read a) => Wizard b String -> Wizard b a +parseRead = parser (readP) + +-- | Translate a maybe value into wizard success/failure. +liftMaybe :: Maybe a -> Wizard b a +liftMaybe (Just v) = pure v +liftMaybe (Nothing) = mzero + +-- | Ensures that a maybe value satisfies a given predicate. +ensure :: (a -> Bool) -> a -> Maybe a +ensure p v | p v = Just v + | otherwise = Nothing + +-- | A read-based parser for the 'parser' modifier. +readP :: Read a => String -> Maybe a +readP = fmap fst . listToMaybe . reads diff --git a/System/Console/Wizard/BasicIO.hs b/System/Console/Wizard/BasicIO.hs new file mode 100644 --- /dev/null +++ b/System/Console/Wizard/BasicIO.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs, KindSignatures #-} +module System.Console.Wizard.BasicIO + ( BasicIO + , runBasicIO + ) where +import System.Console.Wizard +import System.Console.Wizard.Internal +import Control.Monad.Trans +import Control.Monad.Prompt +import Control.Monad.Trans.Maybe +import Control.Applicative((<$>)) + +import Data.Typeable + +-- | A very simple standard IO backend for @wizards@, supporting input and output. +-- Default text and password masks are ignored. +-- A more full-featured back-end is based on Haskeline. +-- Arbitrary IO actions can be performed in wizards via a 'MonadIO' instance. +data BasicIO (m :: * -> *) r = ArbitraryIO (IO r) + +-- | Runs a Wizard action in the BasicIO backend. +runBasicIO :: Wizard BasicIO a -> IO (Maybe a) +runBasicIO (Wizard (MaybeT c)) = runRecPromptM f c + where f :: WizardAction BasicIO (RecPrompt (WizardAction BasicIO) ) c -> IO c + f (Line s) = getLine + f (Character s) = getChar + f (Password s m) = getLine + f (LinePreset s f b) = getLine + f (Output s) = putStr s + f (OutputLn s) = putStrLn s + f (Backend (ArbitraryIO a)) = a + +instance MonadIO (Wizard BasicIO) where + liftIO = prompt . Backend . ArbitraryIO diff --git a/System/Console/Wizard/Haskeline.hs b/System/Console/Wizard/Haskeline.hs new file mode 100644 --- /dev/null +++ b/System/Console/Wizard/Haskeline.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs #-} +module System.Console.Wizard.Haskeline + ( Haskeline + , UnexpectedEOF (..) + , runHaskeline + , withSettings + ) where +import System.Console.Wizard +import System.Console.Wizard.Internal +import System.Console.Haskeline +import Control.Monad.Trans +import Control.Monad.Prompt +import Control.Monad.Trans.Maybe +import Control.Exception +import Data.Typeable + +-- | A Haskeline backend for @wizards@, supporting input, output, default text, and password input. +-- In addition, Haskeline settings can be modified for a single wizard, and arbitrary IO can be +-- performed using the 'MonadIO' instance. +data Haskeline m r = SetSettings (Settings IO) (m r) + | ArbitraryIO (IO r) + +-- | The Haskeline back-end will throw this exception if EOF is encountered +-- when it is not expected. Specifically, when actions such as 'getInputLine' return 'Nothing'. +data UnexpectedEOF = UnexpectedEOF deriving (Show, Typeable) +instance Exception UnexpectedEOF + +-- | Runs a Wizard action in the Haskeline backend. +runHaskeline :: Wizard Haskeline a -> InputT IO (Maybe a) +runHaskeline (Wizard c) = runRecPromptM f $ runMaybeT c + where f :: WizardAction Haskeline (RecPrompt (WizardAction Haskeline) ) a -> InputT IO a + f (Line s) = getInputLine s >>= maybeToException UnexpectedEOF + f (Character s) = getInputChar s >>= maybeToException UnexpectedEOF + f (Password s m) = getPassword m s >>= maybeToException UnexpectedEOF + f (LinePreset s f b) = getInputLineWithInitial s (f,b) >>= maybeToException UnexpectedEOF + f (Output s) = outputStr s + f (OutputLn s) = outputStrLn s + f (Backend (SetSettings s v)) = liftIO $ runInputT s (runRecPromptM f v) + f (Backend (ArbitraryIO a)) = liftIO $ a + +-- | Modifies a wizard so that it will run with different Haskeline 'Settings' to the top level input monad. +withSettings :: Settings IO -> Wizard Haskeline a -> Wizard Haskeline a +withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ prompt $ Backend $ SetSettings sets $ v + +instance MonadIO (Wizard Haskeline) where + liftIO = prompt . Backend . ArbitraryIO + +maybeToException :: (Monad m, Exception e) => e -> Maybe a -> m a +maybeToException e (Just v) = return v +maybeToException e (Nothing) = throw e diff --git a/System/Console/Wizard/Internal.hs b/System/Console/Wizard/Internal.hs new file mode 100644 --- /dev/null +++ b/System/Console/Wizard/Internal.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE GADTs, KindSignatures #-} +module System.Console.Wizard.Internal ( WizardAction (..) + , PromptString (..) + -- $backend + ) where + +type PromptString = String + +-- | Internally, a 'Wizard' is essentially a prompt monad with a 'WizardAction'. A constructor exists for each primitive action, as well +-- as a special \"escape hatch\" constructor ('Backend') used for writing backend-specific primitives and modifiers. +-- Each back-end has a corresponding data type, used as a type parameter for 'Wizard'. This data type is usually opaque, but internally +-- specifies additional primitive actions that are specific to the back-end. +-- 'WizardAction' is parameterised by this data type (for use in the 'Backend' constructor), the prompt monad itself (so that modifiers +-- can be made as well as primitives) and the return type of the action. +data WizardAction :: ((* -> *) -> * -> *) -> (* -> *) -> * -> * where + Line :: PromptString -> WizardAction b m String + LinePreset :: PromptString -> String -> String -> WizardAction b m String + Password :: PromptString -> Maybe Char -> WizardAction b m String + Character :: PromptString -> WizardAction b m Char + Output :: String -> WizardAction b m () + OutputLn :: String -> WizardAction b m () + Backend :: b m a -> WizardAction b m a +-- $backend +-- A short tutorial on writing backends. +-- +-- Backends consist of two main components: +-- +-- 1. A back-end data type (the type parameter to 'Wizard'), which includes constructors +-- for any primitive actions or modifiers that are specific to the back-end. +-- +-- 2. An interpreter function, of type @Wizard DataType a -> B (Maybe a)@ for some type @B@ (depending on the backend). +-- Typically this function will provide semantics for each 'WizardAction' using 'runRecPromptM' or similar. +-- +-- The 'Backend' constructor can be used to add back-end specific primitives and modifiers. +-- +-- As an example, suppose I am writing a back-end to @IO@, like "System.Console.Wizard.BasicIO". +-- One additional primitive action that I might want to include is the ability to run arbitrary @IO@ actions while a wizard is running. +-- So, my backend data type will be: +-- +-- @ +-- data MyBackend (m :: * -> *) r = ArbitraryIO (IO r) -- kind signature to avoid defaulting to * +-- @ +-- +-- And my interpreter function will be: +-- +-- @ +-- runWizardMyBackend :: Wizard MyBackend a -> IO a +-- runWizardMyBackend (Wizard (MaybeT c)) = runRecPromptM f c +-- where f :: WizardAction MyBackend (RecPrompt (WizardAction MyBackend)) a -> IO a +-- f (Output s) = putStr s +-- f (... ) = ... +-- f (Backend (ArbitraryIO io)) = io +-- @ +-- +-- And then the action can be easily defined: +-- +-- @ +-- runIO :: IO a -> Wizard MyBackend a +-- runIO = prompt . Backend . ArbitraryIO +-- @ +-- +-- I might also want to include a /modifier/, which say, colours any output text green. Assuming I have a function +-- @ +-- withGreenText :: IO a -> IO a +-- @ +-- which causes any output produced by the input action to be coloured green, we can use the 'Backend' constructor to transform +-- this into a wizard modifier. +-- +-- @ +--data MyBackend m r = ArbitraryIO (IO r) +-- | GreenText (m r) +-- +--runWizardMyBackend :: Wizard MyBackend +--runWizardMyBackend (Wizard (MaybeT c)) = runRecPromptM f c +-- where f :: WizardAction MyBackend (RecPrompt (WizardAction MyBackend)) a -> IO a +-- f (Output s) = putStr s +-- f (... ) = ... +-- f (Backend (ArbitraryIO io)) = io +-- f (Backend (GreenText a)) = withGreenText $ runRecPromptM f a +-- +--greenText :: Wizard MyBackend a -> Wizard MyBackend a +--greenText (Wizard (MaybeT a)) = prompt (Backend (GreenText a)) +-- @ +-- +-- diff --git a/wizards.cabal b/wizards.cabal new file mode 100644 --- /dev/null +++ b/wizards.cabal @@ -0,0 +1,91 @@ +-- wizards.cabal auto-generated by cabal init. For additional options, +-- see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: wizards + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1 + +-- A short (one-line) description of the package. +Synopsis: High level, generic library for interrogative user interfaces + +-- A longer description of the package. +-- Description: + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Liam O'Connor-Davis + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: liamoc@cse.unsw.edu.au + + +Description: @wizards@ is a package designed for the quick and painless development of /interrogative/ programs, which + revolve around a \"dialogue\" with the user, who is asked a series of questions in a sequence much like an + installation wizard. + . + Everything from interactive system scripts, to installation wizards, to full-blown shells can be implemented with + the support of @wizards@. + . + It is developed transparently on top of a Prompt monad, which separates out the semantics of the program from any + particular interface. A variety of backends exist, including "System.Console.Wizard.Haskeline" and + "System.Console.Wizard.BasicIO". It is also possible to write your own backends. While both built-in backends + operate on a console, there is no reason why @wizards@ cannot also be used for making GUI wizard interfaces. + . + . + See the github page for examples on usage: + . + + . + For creating backends, the module "System.Console.Wizard.Internal" has a brief tutorial. + +-- A copyright notice. +-- Copyright: + +Category: User Interfaces + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + +source-repository head + type: git + location: git://github.com/liamoc/wizards.git + +source-repository this + type: git + location: git://github.com/liamoc/wizards.git + tag: 0.1 + + +Library + -- Modules exported by the library. + Exposed-modules: System.Console.Wizard + System.Console.Wizard.Internal + System.Console.Wizard.Haskeline + System.Console.Wizard.BasicIO + + + -- Packages needed in order to build this package. + Build-depends: base == 4.*, haskeline == 0.6.*, mtl == 2.0.*, transformers == 0.2.*, MonadPrompt == 1.0.* + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +