wizards-1.0.2/0000755000000000000000000000000012505407751011371 5ustar0000000000000000wizards-1.0.2/LICENSE0000644000000000000000000000300012505407751012367 0ustar0000000000000000Copyright (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. wizards-1.0.2/Setup.hs0000644000000000000000000000005612505407751013026 0ustar0000000000000000import Distribution.Simple main = defaultMain wizards-1.0.2/wizards.cabal0000644000000000000000000000654312505407751014050 0ustar0000000000000000-- 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: 1.0.2 -- 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 free monad, which separates out the semantics of the program from any particular interface. A variety of backends exist, including console-based "System.Console.Wizard.Haskeline" and "System.Console.Wizard.BasicIO", and the pure "System.Console.Wizard.Pure". It is also possible to write your own backends, or extend existing back-ends with new features. While both built-in IO 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: 1.0 Library -- Modules exported by the library. Exposed-modules: System.Console.Wizard System.Console.Wizard.Internal System.Console.Wizard.Haskeline System.Console.Wizard.BasicIO System.Console.Wizard.Pure Extensions: OverlappingInstances -- Packages needed in order to build this package. Build-depends: base == 4.*, haskeline >= 0.6 && < 0.8, mtl >= 2.0 && < 2.3, transformers >= 0.1 && < 0.5, control-monad-free >= 0.5 && < 0.7, containers >= 0.4 && < 0.6 -- Modules not exported by this package. -- Other-modules: -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: wizards-1.0.2/System/0000755000000000000000000000000012505407751012655 5ustar0000000000000000wizards-1.0.2/System/Console/0000755000000000000000000000000012505407751014257 5ustar0000000000000000wizards-1.0.2/System/Console/Wizard.hs0000644000000000000000000001154312505407751016057 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, TypeOperators, Trustworthy #-} -- Necessary for MonadIO instance. {-# LANGUAGE UndecidableInstances #-} module System.Console.Wizard ( -- * Wizards -- $intro Wizard (..) , PromptString (..) , run , (:<:) , (:+:) -- * Primitives -- $primitives , Line , line , LinePrewritten , linePrewritten , Password , password , Character , character , Output , output , OutputLn , outputLn , ArbitraryIO -- * 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.Trans import Control.Monad.Free import Control.Monad.Reader import Data.Maybe import Data.Monoid -- $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. -- | Output a string. Does not fail. output :: (Output :<: b) => String -> Wizard b () output s = Wizard $ lift $ inject (Output s (Pure ())) -- | Output a string followed by a newline. Does not fail. outputLn :: (OutputLn :<: b) => String -> Wizard b () outputLn s = Wizard $ lift $ inject (OutputLn s (Pure ())) -- | Read one line of input from the user. Cannot fail (but may throw exceptions, depending on the backend). line :: (Line :<: b) => PromptString -> Wizard b String line s = Wizard $ lift $ inject (Line s Pure) -- | Read a single character only from input. Cannot fail (but may throw exceptions, depending on the backend). character :: (Character :<: b) => PromptString -> Wizard b Char character p = Wizard $ lift $ inject (Character p Pure) instance (ArbitraryIO :<: b) => MonadIO (Wizard b) where liftIO v = Wizard $ lift $ inject (ArbitraryIO v Pure) -- | Read one line of input, with some default text already present, before and/or after the editing cursor. --- Cannot fail (but may throw exceptions, depending on the backend). linePrewritten :: (LinePrewritten :<: b) => PromptString -> String -- ^ Text to the left of the cursor -> String -- ^ Text to the right of the cursor -> Wizard b String linePrewritten p s1 s2 = Wizard $ lift $ inject (LinePrewritten p s1 s2 Pure) -- | Read one line of password input, with an optional mask character. --- Cannot fail (but may throw exceptions, depending on the backend). password :: (Password :<: b) => PromptString -> Maybe Char -- ^ Mask character, if any. -> Wizard b String password p mc = Wizard $ lift $ inject (Password p mc Pure) -- $modifiers -- /Modifiers/ change the behaviour of existing wizards. -- | Retry produces a wizard that will retry the entire conversation again if it fails. -- It is simply @retry x = x \<|\> retry x@. retry :: Functor b => Wizard b a -> Wizard b a retry x = x <|> retry x -- | Same as 'retry', except an error message can be specified. retryMsg :: (OutputLn :<: b) => 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 :: Functor b => 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 :: Functor b => (a -> Maybe c) -> Wizard b a -> Wizard b c parser f a = a >>= liftMaybe . f -- | @validator p@ causes a wizard to fail if the output value does not satisfy the predicate @p@. validator :: Functor b => (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 :: Functor b => 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, Functor b) => (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, Functor b) => Wizard b String -> Wizard b a parseRead = parser (readP) -- | Translate a maybe value into wizard success/failure. liftMaybe :: Functor b => 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 wizards-1.0.2/System/Console/Wizard/0000755000000000000000000000000012505407751015517 5ustar0000000000000000wizards-1.0.2/System/Console/Wizard/BasicIO.hs0000644000000000000000000000327612505407751017334 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-} module System.Console.Wizard.BasicIO ( BasicIO , basicIO ) where import System.Console.Wizard import System.Console.Wizard.Internal import Control.Monad.Trans import Control.Monad.Trans.Maybe instance Run IO Output where runAlgebra (Output s w) = putStr s >> w instance Run IO OutputLn where runAlgebra (OutputLn s w) = putStrLn s >> w instance Run IO Line where runAlgebra (Line s w) = getLine >>= w instance Run IO Character where runAlgebra (Character s w) = getChar >>= w instance Run IO ArbitraryIO where runAlgebra (ArbitraryIO iov f) = iov >>= f -- | The 'BasicIO' backend supports only simple input and output. -- Support for 'Password' and 'LinePrewritten' features can be added with -- a shim from 'System.Console.Wizard.Shim'. newtype BasicIO a = BasicIO (( Output :+: OutputLn :+: Line :+: Character :+: ArbitraryIO) a) deriving ( (:<:) Output , (:<:) OutputLn , (:<:) Line , (:<:) Character , (:<:) ArbitraryIO , Functor , Run IO ) -- | A simple identity function, used to restrict types if the type inferred by GHC is too general. -- You could achieve the same effect with a type signature, but this is slightly less typing. basicIO :: Wizard BasicIO a -> Wizard BasicIO a basicIO = id wizards-1.0.2/System/Console/Wizard/Haskeline.hs0000644000000000000000000000655112505407751017765 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-} module System.Console.Wizard.Haskeline ( UnexpectedEOF (..) , Haskeline , haskeline , withSettings , WithSettings(..) ) where import System.Console.Wizard import System.Console.Wizard.Internal import System.Console.Haskeline import Control.Monad.Trans import Control.Monad.Trans.Maybe import Control.Exception import Data.Typeable -- | 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 -- | Haskeline supports all the following features completely. newtype Haskeline a = Haskeline (( Output :+: OutputLn :+: Line :+: Character :+: LinePrewritten :+: Password :+: ArbitraryIO :+: WithSettings) a) deriving ( (:<:) Output , (:<:) OutputLn , (:<:) Line , (:<:) Character , (:<:) LinePrewritten , (:<:) Password , (:<:) ArbitraryIO , (:<:) WithSettings , Functor , Run (InputT IO) ) -- | Modifies a wizard so that it will run with different Haskeline 'Settings' to the top level input monad. withSettings :: (WithSettings :<: b) => Settings IO -> Wizard b a -> Wizard b a withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ inject (WithSettings sets v) data WithSettings w = WithSettings (Settings IO) w deriving (Functor) instance Run (InputT IO) Output where runAlgebra (Output s w) = outputStr s >> w instance Run (InputT IO) OutputLn where runAlgebra (OutputLn s w) = outputStrLn s >> w instance Run (InputT IO) Line where runAlgebra (Line s w) = getInputLine s >>= mEof w instance Run (InputT IO) Character where runAlgebra (Character s w) = getInputChar s >>= mEof w instance Run (InputT IO) LinePrewritten where runAlgebra (LinePrewritten p s1 s2 w) = getInputLineWithInitial p (s1,s2) >>= mEof w instance Run (InputT IO) Password where runAlgebra (Password p mc w) = getPassword mc p >>= mEof w instance Run (InputT IO) ArbitraryIO where runAlgebra (ArbitraryIO iov f) = liftIO iov >>= f instance Run (InputT IO) WithSettings where runAlgebra (WithSettings sets w) = liftIO (runInputT sets w) mEof = maybe (throw UnexpectedEOF) -- | A simple identity function, used to restrict types if the type inferred by GHC is too general. -- You could achieve the same effect with a type signature, but this is slightly less typing. haskeline :: Wizard Haskeline a -> Wizard Haskeline a haskeline = id wizards-1.0.2/System/Console/Wizard/Internal.hs0000644000000000000000000001702012505407751017627 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor, FlexibleContexts, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy, ExistentialQuantification, EmptyDataDecls #-} module System.Console.Wizard.Internal ( Wizard (..) , PromptString (..) , (:+:) (..) , (:<:) , inject , Run (..) , run -- $functors , Output (..) , OutputLn (..) , Line (..) , LinePrewritten (..) , Password (..) , Character (..) , ArbitraryIO (..) -- $backend ) where import Control.Monad.Free import Control.Monad.Trans.Maybe import Control.Applicative -- | A string for a prompt type PromptString = String -- | A @Wizard b a@ is a conversation with the user via back-end @b@ 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. `mzero` can be used to induce failure directly. -- -- 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 free monad built from some coproduct of functors, -- each of which is a primitive action. newtype Wizard backend a = Wizard (MaybeT (Free backend) a) deriving (Monad, Functor, Applicative, Alternative, MonadPlus) -- | Coproduct of two functors data (f :+: g) w = Inl (f w) | Inr (g w) deriving Functor -- | Subsumption of two functors. You shouldn't define any of your own instances of this when writing back-ends, rely only on GeneralizedNewtypeDeriving. class (Functor sub, Functor sup) => sub :<: sup where inj :: sub a -> sup a instance Functor f => f :<: f where inj = id instance (Functor f, Functor g) => f :<: (f :+: g) where inj = Inl instance (Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where inj = Inr . inj -- | Injection function for free monads, see \"Data Types a la Carte\" from Walter Swierstra, @http:\/\/www.cs.ru.nl\/~W.Swierstra\/Publications\/DataTypesALaCarte.pdf@ inject :: (g :<: f ) => g (Free f a) -> Free f a inject = Impure . inj -- | A class for implementing actions on a backend. E.g Run IO Output provides an interpreter for the Output action in the IO monad. class Run a b where runAlgebra :: b (a v) -> a v instance (Run b f, Run b g) => Run b (f :+: g) where runAlgebra (Inl r) = runAlgebra r runAlgebra (Inr r) = runAlgebra r infixr 9 :+: -- $functors -- Each of the following functors is a primitive action. A back-end provides interpreters for these actions using the 'Run' class, data Output w = Output String w deriving Functor data OutputLn w = OutputLn String w deriving Functor data Line w = Line PromptString (String -> w) deriving Functor data Character w = Character PromptString (Char -> w) deriving Functor data LinePrewritten w = LinePrewritten PromptString String String (String -> w) deriving Functor data Password w = Password PromptString (Maybe Char) (String -> w) deriving Functor data ArbitraryIO w = forall a. ArbitraryIO (IO a) (a -> w) instance Functor (ArbitraryIO) where fmap f (ArbitraryIO iov f') = ArbitraryIO iov (fmap f f') run' :: (Functor f, Monad b, Run b f) => Free f a -> b a run' = foldFree return runAlgebra -- | Run a wizard using some back-end. run :: (Functor f, Monad b, Run b f) => Wizard f a -> b (Maybe a) run (Wizard c) = run' (runMaybeT c) -- $backend -- A short tutorial on writing backends. -- -- Backends consist of two main components: -- -- 1. A monad, @M@, in which the primitive actions are interpreted. 'Run' instances specify an interpreter for each supported -- action, e.g @Run M Output@ will specify an interpreter for the 'Output' primitive action in the monad M. -- -- 2. A newtype, e.g @Backend a@, which is a functor, usually implemented by wrapping a coproduct of all supported features. -- '(:<:)' instances, the 'Functor' instance, and the 'Run' instance are provided by generalized newtype deriving. -- -- As an example, suppose I am writing a back-end to @IO@, like "System.Console.Wizard.BasicIO". I want to support basic input and output, -- and arbitrary IO, so I declare instances for 'Run' for the 'IO' monad: -- -- @ -- instance Run IO Output where runAlgebra (Output s w) = putStr s >> w -- instance Run IO OutputLn where runAlgebra (OutputLn s w) = putStrLn s >> w -- instance Run IO Line where runAlgebra (Line s w) = getLine >>= w -- instance Run IO Character where runAlgebra (Character s w) = getChar >>= w -- instance Run IO ArbitraryIO where runAlgebra (ArbitraryIO iov f) = iov >>= f -- @ -- -- And then I would define the newtype for the backend, which we can call @MyIOBackend@: -- -- @ -- newtype MyIOBackend a = MyIOBackend ((Output :+: OutputLn :+: Line :+: Character :+: ArbitraryIO) a) -- deriving ( Functor, Run IO -- , (:<:) Output -- , (:<:) OutputLn -- , (:<:) Line -- , (:<:) Character -- , (:<:) ArbitraryIO -- ) -- @ -- -- A useful convenience is to provide a simple identity function to serve as a type coercion: -- -- @ -- myIOBackend :: Wizard MyIOBackend a -> Wizard MyIOBackend a -- myIOBackend = id -- @ -- -- One additional primitive action that I might want to include is the ability to clear the screen at a certain point. -- So, we define a new data type for the action: -- -- @ -- data ClearScreen w = ClearScreen w deriving Functor -- via -XDeriveFunctor -- @ -- -- And a \"smart\" constructor for use by the user: -- -- @ -- clearScreen :: (ClearScreen :\<: b) => Wizard b () -- clearScreen = Wizard $ lift $ inject (ClearScreen (Pure ())) -- @ -- -- (These smart constructors all follow a similar pattern. See the source of "System.Console.Wizard" for more examples) -- -- And then we define an interpreter for it: -- -- @ -- instance Run IO ArbitraryIO where runAlgebra (ClearScreen f) = clearTheScreen >> f -- @ -- -- Now, we can use this as-is simply by directly extending our back-end: -- -- @ -- foo :: Wizard (ClearScreen :+: MyIOBackend) -- foo = clearScreen >> output \"Hello World!\" -- @ -- -- Or, we could modify @MyIOBackend@ to include the extension directly. -- -- -- For custom actions that /return/ output, the definition looks slightly different. Here is the definition of Line: -- -- @ -- data Line w = Line (PromptString) (String -> w) deriving Functor -- via -XDeriveFunctor -- @ -- -- And the smart constructor looks like this: -- -- @ -- line :: (Line :\<: b) => PromptString -> Wizard b String -- line s = Wizard $ lift $ inject (Line s Pure) -- @wizards-1.0.2/System/Console/Wizard/Pure.hs0000644000000000000000000000605712505407751016776 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, FlexibleInstances, TypeOperators, DoAndIfThenElse, GeneralizedNewtypeDeriving, Trustworthy #-} module System.Console.Wizard.Pure ( Pure , UnexpectedEOI (..) , runPure , PureState (..) ) where import System.Console.Wizard import System.Console.Wizard.Internal import Control.Monad.Trans import Control.Monad.State.Lazy import Control.Monad.Trans.Maybe import Control.Applicative((<$>)) import Data.Typeable import Data.Sequence(Seq, (|>), (><), fromList, empty) import Control.Monad import Control.Exception import Control.Arrow import Data.Foldable(toList) -- | Thrown if the wizard ever unexpectedly runs out of input. data UnexpectedEOI = UnexpectedEOI deriving (Show, Typeable) instance Exception UnexpectedEOI -- | The pure backend is actually just a simple state monad, with the following state. type PureState = ([String], Seq Char) -- | Run a wizard in the Pure backend runPure :: Wizard Pure a -> String -> (Maybe a, String) runPure wz input = let (a,(_,o)) = runState (run wz) (lines input, empty) in (a, toList o) getPureLine :: State PureState String getPureLine = do crashIfNull x <- head . fst <$> get modify (first tail) return x crashIfNull :: State PureState () crashIfNull = do (x, y ) <- get when (null x) $ throw UnexpectedEOI getPureChar :: State PureState Char getPureChar = do crashIfNull x <- null . head . fst <$> get if x then do modify (first tail) return '\n' else do r <- head . head . fst <$> get modify (first (\ (x : r) -> tail x : r)) return r outputPure :: String -> State PureState () outputPure s = modify (second (>< fromList s)) >> modify (\s -> s `seq` s) outputLnPure :: String -> State PureState () outputLnPure s = modify (second $ (|> '\n') . (>< fromList s)) >> modify (\s -> s `seq` s) instance Run (State PureState) Output where runAlgebra (Output s w) = outputPure s >> w instance Run (State PureState) OutputLn where runAlgebra (OutputLn s w) = outputLnPure s >> w instance Run (State PureState) Line where runAlgebra (Line s w) = getPureLine >>= w instance Run (State PureState) Character where runAlgebra (Character s w) = getPureChar >>= w -- | The 'Pure' backend supports only simple input and output. -- Support for 'Password' and 'LinePrewritten' features can be added with -- a shim from "System.Console.Wizard.Shim". newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a) deriving ( (:<:) Output , (:<:) OutputLn , (:<:) Line , (:<:) Character , Functor , Run (State PureState) )