packages feed

wizards 0.1 → 1.0

raw patch · 6 files changed

+372/−181 lines, 6 filesdep +containersdep +control-monad-freedep −MonadPrompt

Dependencies added: containers, control-monad-free

Dependencies removed: MonadPrompt

Files

System/Console/Wizard.hs view
@@ -1,17 +1,29 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, Trustworthy, MultiParamTypeClasses, FlexibleInstances #-}+{-# 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+    , character+    , Output      , output+    , OutputLn     , outputLn+    , ArbitraryIO       -- * Modifiers       -- $modifiers     , retry@@ -30,104 +42,95 @@     ) 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 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--+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. --- | Read one line of input from the user.-line :: PromptString -> Wizard b String-line str = prompt $ Line str+-- | 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.---   Backends are not required to display this default text, or position the cursor anywhere, it is merely---   a suggestion.-linePrewritten :: PromptString+---  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 = prompt $ LinePreset p s1 s2+linePrewritten p s1 s2 = Wizard $ lift $ inject (LinePrewritten p s1 s2 Pure)  -- | 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+---  Cannot fail (but may throw exceptions, depending on the backend).+password :: (Password :<: b)+         => 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+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.--- 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."+-- 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 the error message can be specified.-retryMsg :: String -> Wizard b a -> Wizard b a+-- | 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 :: Wizard b a -> a -> Wizard b a+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 :: (a -> Maybe c) -> Wizard b a -> Wizard b c+parser :: Functor b => (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 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 :: Wizard b [a] -> Wizard b [a]+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) => (a,a) -> Wizard b a -> Wizard b a+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) => Wizard b String -> Wizard b a+parseRead :: (Read a, Functor b) => Wizard b String -> Wizard b a parseRead = parser (readP)  -- | Translate a maybe value into wizard success/failure.	-liftMaybe :: Maybe a -> Wizard b a+liftMaybe :: Functor b => Maybe a -> Wizard b a liftMaybe (Just v) = pure v liftMaybe (Nothing) = mzero
System/Console/Wizard/BasicIO.hs view
@@ -1,34 +1,37 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs, KindSignatures #-}-module System.Console.Wizard.BasicIO+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-}+module System.Console.Wizard.BasicIO          ( BasicIO-        , runBasicIO+        , basicIO         ) where import System.Console.Wizard-import System.Console.Wizard.Internal +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)+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 --- | 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+-- | 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+                           ) -instance MonadIO (Wizard BasicIO) where-    liftIO = prompt . Backend . ArbitraryIO+-- | 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
System/Console/Wizard/Haskeline.hs view
@@ -1,50 +1,66 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-} module System.Console.Wizard.Haskeline -        ( Haskeline-        , UnexpectedEOF (..)-        , runHaskeline+        ( 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.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+-- | 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 :: Settings IO -> Wizard Haskeline a -> Wizard Haskeline a-withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ prompt $ Backend $ SetSettings sets $ v+withSettings :: (WithSettings :<: b) => Settings IO -> Wizard b a -> Wizard b a+withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ inject (WithSettings sets v) -instance MonadIO (Wizard Haskeline) where-    liftIO = prompt . Backend . ArbitraryIO+data WithSettings w = WithSettings (Settings IO) w deriving (Functor)  -maybeToException :: (Monad m, Exception e) => e -> Maybe a -> m a-maybeToException e (Just v) = return v-maybeToException e (Nothing) = throw e+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+
System/Console/Wizard/Internal.hs view
@@ -1,85 +1,172 @@-{-# LANGUAGE GADTs, KindSignatures #-}-module System.Console.Wizard.Internal ( WizardAction (..)+{-# 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 -type PromptString = String +-- | A string for a prompt+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+-- | 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 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.+--      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. 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.+--      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".---   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:+--   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:  ----- @--- data MyBackend (m :: * -> *) r = ArbitraryIO (IO r) -- kind signature to avoid defaulting to *--- @+--  @+--  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+--  @ -- ---   And my interpreter function will be:+--  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: ----- @---   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--- @+--  @+--  data ClearScreen w = ClearScreen w deriving Functor -- via -XDeriveFunctor+--  @ -- --- And then the action can be easily defined:+--  And a \"smart\" constructor for use by the user: ----- @---   runIO :: IO a -> Wizard MyBackend a---   runIO = prompt . Backend . ArbitraryIO --- @+--  @+--  clearScreen :: (ClearScreen :\<: b) => Wizard b ()+--  clearScreen = Wizard $ lift $ inject (ClearScreen (Pure ())) +--  @ ----- 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.+--  (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: -- --- @---data MyBackend m r = ArbitraryIO (IO r)---                   | GreenText (m r)+--  @+--  instance Run IO ArbitraryIO where runAlgebra (ClearScreen f) = clearTheScreen >> f+--  @ -----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+--  Now, we can use this as-is simply by directly extending our back-end: -----greenText :: Wizard MyBackend a -> Wizard MyBackend a---greenText (Wizard (MaybeT a)) = prompt (Backend (GreenText a))--- @+--  @+--  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) +--  @
+ System/Console/Wizard/Pure.hs view
@@ -0,0 +1,80 @@+{-# 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)+                        )+
wizards.cabal view
@@ -7,7 +7,7 @@ -- 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+Version:             1.0  -- A short (one-line) description of the package. Synopsis:            High level, generic library for interrogative user interfaces@@ -36,10 +36,11 @@   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.+  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:@@ -69,7 +70,7 @@ source-repository this    type:     git       location: git://github.com/liamoc/wizards.git-   tag:      0.1+   tag:      1.0   Library@@ -78,10 +79,11 @@                    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.*, mtl == 2.0.*, transformers == 0.2.*, MonadPrompt == 1.0.*+  Build-depends: base == 4.*, haskeline == 0.6.*, mtl == 2.0.*, transformers == 0.2.*, control-monad-free ==0.5.*, containers == 0.4.*      -- Modules not exported by this package.   -- Other-modules: