├── .gitignore ├── Examples.hs ├── LICENSE ├── README.md ├── Setup.hs ├── System └── Console │ ├── Wizard.hs │ └── Wizard │ ├── BasicIO.hs │ ├── Haskeline.hs │ ├── Internal.hs │ ├── Pure.hs │ ├── Shim.hs │ └── Shim │ ├── LinePrewritten.hs │ └── Password.hs ├── Test.hs └── wizards.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ -------------------------------------------------------------------------------- /Examples.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances, TypeOperators, FlexibleContexts #-} 2 | import System.Console.Haskeline 3 | import System.Console.Wizard 4 | import System.Console.Wizard.Haskeline -- 5 | import System.Console.Wizard.BasicIO -- choose a backend, Haskeline recommended. 6 | import System.Console.Wizard.Pure -- 7 | import Control.Applicative 8 | import Control.Monad 9 | import Control.Monad.Trans 10 | import Data.Monoid 11 | 12 | type Name = String 13 | type Class = Int 14 | data Student = Student Name Class deriving (Show) 15 | 16 | nameWizard :: (Line :<: b) => Wizard b Name 17 | nameWizard = retry $ nonEmpty $ line "Name: " 18 | 19 | classWizard :: (Line :<: b) => Wizard b Class 20 | classWizard = retry 21 | $ inRange (1,5) 22 | $ parseRead 23 | $ nonEmpty (line "Class[1]: ") `defaultTo` "1" 24 | 25 | studentWizard :: (Line :<: b) => Wizard b Student 26 | studentWizard = Student <$> nameWizard <*> classWizard 27 | 28 | main22 :: IO () 29 | main22 = (run $ basicIO $ studentWizard) >>= print 30 | 31 | 32 | main12 :: IO () 33 | main12 = runInputT defaultSettings (run $ haskeline $ studentWizard) 34 | >>= print 35 | 36 | 37 | 38 | passwordW :: (Password :<: b, OutputLn :<: b) => String -> Wizard b () 39 | passwordW realPassword = 40 | let 41 | w = do validator (== realPassword) $ password "Enter password: " (Just '*') 42 | outputLn "The secret is 42" 43 | in w <|> w <|> w <|> outputLn "Password rejected. Goodbye!" 44 | 45 | main1 :: IO () 46 | main1 = void $ runInputT defaultSettings $ run $ haskeline $ passwordW "rosebud" 47 | 48 | 49 | passwordW2 :: (Password :<: b, OutputLn :<: b) => String -> Wizard b () 50 | passwordW2 realPassword = (retryMsg "Incorrect password." 51 | $ validator (== realPassword) 52 | $ password "Enter password: " (Just '*')) 53 | >> outputLn "The secret is 42" 54 | 55 | parseSticks :: String -> Maybe Int 56 | parseSticks [] = Just 0 57 | parseSticks ('|':r) = fmap (+1) $ parseSticks r 58 | parseSticks (_:_) = Nothing 59 | 60 | sticksW = (do s <- parser parseSticks (line "Enter sticks!: ") 61 | outputLn $ "I found " ++ show s ++ " sticks!") 62 | <|> outputLn "I found something that wasn't a stick and got confused." 63 | 64 | main3 :: IO () 65 | main3 = void $ runInputT defaultSettings $ run $ haskeline $ sticksW 66 | 67 | missilesW :: (ArbitraryIO :<: b, Character :<: b) => Wizard b () 68 | missilesW = do retry $ validator (== 'x') $ character "Press 'X' to fire the missiles" 69 | liftIO $ fireTheMissiles 70 | where fireTheMissiles = putStrLn "FIRE!" 71 | 72 | specialHistory :: (WithSettings :<: b, Line :<: b, Output :<: b) => Wizard b () 73 | specialHistory = withSettings (defaultSettings {historyFile = Just "histfile"}) 74 | $ line "Answers to this question are recorded in histfile" >>= output 75 | 76 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012, Liam O'Connor-Davis 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Liam O'Connor-Davis nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Wizards 2 | 3 | `wizards` is an Haskell library 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. 4 | 5 | Everything from interactive system scripts, to installation wizards, to full-blown shells can be implemented with the support of `wizards`. 6 | 7 | It is developed transparently on top of a free monad (see [Swierstra's excellent paper on this topic](http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf)), which separates out the semantics of the program from the wizards interface. A variety of backends exist, including a full featured backend for Haskeline, a debug-friendly simpler implementation in terms of `System.IO` primitives, and a completely pure implementation modelled as a function from an input string to output. It is also possible to write your own backends, or extend the existing back-ends with new features. 8 | 9 | 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. 10 | 11 | Below are installation instructions and some educational examples. 12 | 13 | Information on how to write backends or extend backends, as well as structured API documentation is available on Hackage: 14 | 15 | http://hackage.haskell.org/package/wizards 16 | 17 | (Or, you can just run `cabal haddock` to generate the documentation from the source). 18 | 19 | ## Installing 20 | 21 | To install with cabal from hackage, just go: 22 | 23 | ``` 24 | cabal install wizards 25 | ``` 26 | 27 | Otherwise, to install from source: 28 | 29 | ``` 30 | git clone https://github.com/liamoc/wizards.git 31 | cd wizards 32 | runhaskell Setup.hs configure 33 | runhaskell Setup.hs build 34 | runhaskell Setup.hs install 35 | ``` 36 | 37 | Or, if you have cabal, you can replace `runhaskell Setup.hs` with `cabal` there. 38 | 39 | ## Howto 40 | 41 | A value of type `Wizard b a` is a conversation with the user via back-end `b` that will result in a value of type `a`, or fail. Monad, Applicative and Alternative instances are defined. Code can also be written monomorphically for a specific back-end: 42 | 43 | ```haskell 44 | foo :: Wizard Haskeline Int 45 | ``` 46 | 47 | Or polymorphically for many back-ends like so: 48 | 49 | ```haskell 50 | foo :: (Output :<: b, Line :<: b) => Wizard b Int 51 | ``` 52 | 53 | This describes a `Wizard` that will result in an `Int` that runs on any back-end that supports capabilities for `Output` and `Line`. 54 | 55 | Below are a series of educational examples. You'll probably need to run them with `-XOverlappingInstances`. If you want more structured documentation, please refer to the API documentation on Hackage (or generate it with `cabal haddock`). 56 | 57 | ```haskell 58 | {-# LANGUAGE OverlappingInstances, TypeOperators, FlexibleContexts #-} 59 | import System.Console.Haskeline 60 | import System.Console.Wizard 61 | import System.Console.Wizard.Haskeline -- 62 | import System.Console.Wizard.BasicIO -- choose a backend, Haskeline recommended. 63 | import System.Console.Wizard.Pure -- 64 | import Control.Applicative 65 | import Control.Monad 66 | import Control.Monad.Trans 67 | import Data.Monoid 68 | ``` 69 | 70 | 71 | ### Student Records 72 | 73 | This example demonstrates use of the `Applicative` instance to build up data structures, `retry`, `inRange`, `defaultTo`, and `parseRead`. 74 | 75 | 76 | Suppose we have a `Student` data type, that contains a name and a class number (which we shall say must be in the interval [1,5]). 77 | 78 | ```haskell 79 | type Name = String 80 | type Class = Int 81 | data Student = Student Name Class deriving (Show) 82 | ``` 83 | 84 | A `Name` must be a non-empty string. If the user enters an empty string, we will prompt them again: 85 | 86 | ```haskell 87 | nameWizard :: (Line :<: b) => Wizard b Name 88 | nameWizard = retry $ nonEmpty $ line "Name: " 89 | ``` 90 | 91 | A `Class` must be between 1 and 5. If the user enters nothing, we will default to 1. If they enter an invalid string, they will be prompted again: 92 | 93 | ```haskell 94 | classWizard :: (Line :<: b) => Wizard b Class 95 | classWizard = retry 96 | $ inRange (1,5) 97 | $ parseRead 98 | $ nonEmpty (line "Class[1]: ") `defaultTo` "1" 99 | ``` 100 | 101 | We can now populate a `Student` data type using the `Applicative` instance of `Wizard b`. 102 | 103 | ```haskell 104 | studentWizard :: (Line :<: b) => Wizard b Student 105 | studentWizard = Student <$> nameWizard <*> classWizard 106 | ``` 107 | 108 | And run our wizard with the Haskeline back-end: 109 | 110 | ```haskell 111 | main :: IO () 112 | main = runInputT defaultSettings (run $ haskeline $ studentWizard) 113 | >>= print 114 | ``` 115 | 116 | Or with the Basic IO back-end: 117 | 118 | ```haskell 119 | main :: IO () 120 | main = (run $ basicIO $ studentWizard) >>= print 121 | ``` 122 | 123 | ### Passwords 124 | 125 | This example demonstrates masked input, failure (using `Alternative`), and `retryMsg`, as well as simple use of `validator` and `outputLn`. 126 | 127 | Ask for a password three times, then fail: 128 | 129 | ```haskell 130 | passwordW :: (Password :<: b, OutputLn :<: b) => String -> Wizard b () 131 | passwordW realPassword = 132 | let 133 | w = do validator (== realPassword) $ password "Enter password: " (Just '*') 134 | outputLn "The secret is 42" 135 | in w <|> w <|> w <|> outputLn "Password rejected. Goodbye!" 136 | ``` 137 | 138 | Here we use `validator` to check if the user has entered the correct password, and, if so, print out a secret message. 139 | 140 | Or, for unlimited tries, we can use the `retryMsg` function (or just `retry`): 141 | 142 | ```haskell 143 | passwordW2 :: (Password :<: b, OutputLn :<: b) => String -> Wizard b () 144 | passwordW2 realPassword = (retryMsg "Incorrect password." 145 | $ validator (== realPassword) 146 | $ password "Enter password: " (Just '*')) 147 | >> outputLn "The secret is 42" 148 | ``` 149 | To run this in the Haskeline back-end, we can simply use it as follows: 150 | 151 | ```haskell 152 | main :: IO () 153 | main = void $ runInputT defaultSettings $ run $ haskeline $ passwordW "rosebud" 154 | ``` 155 | 156 | The Basic IO back-end, however, doesn't support password input. We can extend it to simply read a line of unmasked text for password input (i.e ignoring the mask character) easily; by importing the relevant Shim module: 157 | 158 | ```haskell 159 | -- don't import this with Haskeline, or Overlapping instances will muck up your password input 160 | import System.Console.Wizard.Shim.Password 161 | ``` 162 | 163 | And running it with the extension, like so: 164 | 165 | ```haskell 166 | main = void $ run $ (passwordW "rosebud" :: Wizard (Password :+: BasicIO) ()) 167 | ``` 168 | 169 | ### Counting sticks (custom parsers) 170 | 171 | This example demonstrates using custom parse functions. 172 | 173 | Suppose we have a parser that picks up sticks: 174 | 175 | ```haskell 176 | parseSticks :: String -> Maybe Int 177 | parseSticks [] = Just 0 178 | parseSticks ('|':r) = fmap (+1) $ parseSticks r 179 | parseSticks (_:_) = Nothing 180 | ``` 181 | 182 | We can equip a wizard with this parser using the `parser` modifier: 183 | 184 | ```haskell 185 | sticksW = (do s <- parser parseSticks (line "Enter sticks!: ") 186 | outputLn $ "I found " ++ show s ++ " sticks!") 187 | <|> outputLn "I found something that wasn't a stick and got confused." 188 | 189 | main :: IO () 190 | main = void $ runInputT defaultSettings $ run $ haskeline $ sticksW 191 | ``` 192 | 193 | This will run the parseSticks parser on the user input, and, if it succeeds, output the number of sticks parsed. If it fails, it will output an error message. 194 | 195 | ## Extended features 196 | 197 | The Haskeline and BasicIO backends (or any backends that supports the `ArbitraryIO` capability) also support embedding arbitrary IO actions 198 | inside wizards through a `MonadIO` instance. For example: 199 | 200 | ```haskell 201 | missilesW :: (ArbitraryIO :<: b, Character :<: b) => Wizard b () 202 | missilesW = do retry $ validator (== 'x') $ character "Press 'X' to fire the missiles" 203 | liftIO $ fireTheMissiles 204 | where fireTheMissiles = putStrLn "FIRE!" 205 | ``` 206 | 207 | Another backend-specific feature unique to the Haskeline backend allows setting Haskeline settings through a wizard modifier, for example: 208 | 209 | ```haskell 210 | specialHistory :: (WithSettings :<: b, Line :<: b, Output :<: b) => Wizard b () 211 | specialHistory = withSettings (defaultSettings {historyFile = Just "histfile"}) 212 | $ line "Answers to this question are recorded in histfile" >>= output 213 | ``` 214 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /System/Console/Wizard.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts, TypeOperators, Trustworthy #-} 2 | -- Necessary for MonadIO instance. 3 | {-# LANGUAGE UndecidableInstances #-} 4 | module System.Console.Wizard 5 | ( -- * Wizards 6 | -- $intro 7 | Wizard (..) 8 | , PromptString (..) 9 | , run 10 | , (:<:) 11 | , (:+:) 12 | -- * Primitives 13 | -- $primitives 14 | , Line 15 | , line 16 | , LinePrewritten 17 | , linePrewritten 18 | , Password 19 | , password 20 | , Character 21 | , character 22 | , Output 23 | , output 24 | , OutputLn 25 | , outputLn 26 | , ArbitraryIO 27 | -- * Modifiers 28 | -- $modifiers 29 | , retry 30 | , retryMsg 31 | , defaultTo 32 | , parser 33 | , validator 34 | -- * Convenience 35 | , nonEmpty 36 | , inRange 37 | , parseRead 38 | -- * Utility 39 | , liftMaybe 40 | , ensure 41 | , readP 42 | ) where 43 | 44 | import System.Console.Wizard.Internal 45 | 46 | import Control.Applicative 47 | import Control.Monad.Trans.Maybe 48 | import Control.Monad.Trans 49 | import Control.Monad.Free 50 | import Control.Monad.Reader 51 | import Data.Maybe 52 | import Data.Monoid 53 | 54 | -- $primitives 55 | -- /Primitives/ are the basic building blocks for @wizards@. Use these functions to produce wizards that 56 | -- ask for input from the user, or output information. 57 | 58 | -- | Output a string. Does not fail. 59 | output :: (Output :<: b) => String -> Wizard b () 60 | output s = Wizard $ lift $ inject (Output s (Pure ())) 61 | 62 | -- | Output a string followed by a newline. Does not fail. 63 | outputLn :: (OutputLn :<: b) => String -> Wizard b () 64 | outputLn s = Wizard $ lift $ inject (OutputLn s (Pure ())) 65 | 66 | -- | Read one line of input from the user. Cannot fail (but may throw exceptions, depending on the backend). 67 | line :: (Line :<: b) => PromptString -> Wizard b String 68 | line s = Wizard $ lift $ inject (Line s Pure) 69 | 70 | -- | Read a single character only from input. Cannot fail (but may throw exceptions, depending on the backend). 71 | character :: (Character :<: b) 72 | => PromptString 73 | -> Wizard b Char 74 | character p = Wizard $ lift $ inject (Character p Pure) 75 | 76 | 77 | instance (ArbitraryIO :<: b) => MonadIO (Wizard b) where 78 | liftIO v = Wizard $ lift $ inject (ArbitraryIO v Pure) 79 | -- | Read one line of input, with some default text already present, before and/or after the editing cursor. 80 | --- Cannot fail (but may throw exceptions, depending on the backend). 81 | linePrewritten :: (LinePrewritten :<: b) 82 | => PromptString 83 | -> String -- ^ Text to the left of the cursor 84 | -> String -- ^ Text to the right of the cursor 85 | -> Wizard b String 86 | linePrewritten p s1 s2 = Wizard $ lift $ inject (LinePrewritten p s1 s2 Pure) 87 | 88 | -- | Read one line of password input, with an optional mask character. 89 | --- Cannot fail (but may throw exceptions, depending on the backend). 90 | password :: (Password :<: b) 91 | => PromptString 92 | -> Maybe Char -- ^ Mask character, if any. 93 | -> Wizard b String 94 | password p mc = Wizard $ lift $ inject (Password p mc Pure) 95 | 96 | -- $modifiers 97 | -- /Modifiers/ change the behaviour of existing wizards. 98 | 99 | -- | Retry produces a wizard that will retry the entire conversation again if it fails. 100 | -- It is simply @retry x = x \<|\> retry x@. 101 | retry :: Functor b => Wizard b a -> Wizard b a 102 | retry x = x <|> retry x 103 | 104 | -- | Same as 'retry', except an error message can be specified. 105 | retryMsg :: (OutputLn :<: b) => String -> Wizard b a -> Wizard b a 106 | retryMsg msg x = x <|> (outputLn msg >> retryMsg msg x) 107 | 108 | -- | @x \`defaultTo\` y@ will return @y@ if @x@ fails, e.g @parseRead line \`defaultTo\` 0@. 109 | defaultTo :: Functor b => Wizard b a -> a -> Wizard b a 110 | defaultTo wz d = wz <|> pure d 111 | 112 | -- | Like 'fmap', except the function may be partial ('Nothing' causes the wizard to fail). 113 | parser :: Functor b => (a -> Maybe c) -> Wizard b a -> Wizard b c 114 | parser f a = a >>= liftMaybe . f 115 | 116 | -- | @validator p@ causes a wizard to fail if the output value does not satisfy the predicate @p@. 117 | validator :: Functor b => (a -> Bool) -> Wizard b a -> Wizard b a 118 | validator = parser . ensure 119 | 120 | -- | Simply @validator (not . null)@, makes a wizard fail if it gets an empty string. 121 | nonEmpty :: Functor b => Wizard b [a] -> Wizard b [a] 122 | nonEmpty = validator (not . null) 123 | 124 | -- | Makes a wizard fail if it gets an ordered quantity outside of the given range. 125 | inRange :: (Ord a, Functor b) => (a,a) -> Wizard b a -> Wizard b a 126 | inRange (b,t) = validator (\x -> b <= x && x <= t) 127 | 128 | -- | Simply @parser readP@. Attaches a simple @read@ parser to a 'Wizard'. 129 | parseRead :: (Read a, Functor b) => Wizard b String -> Wizard b a 130 | parseRead = parser (readP) 131 | 132 | -- | Translate a maybe value into wizard success/failure. 133 | liftMaybe :: Functor b => Maybe a -> Wizard b a 134 | liftMaybe (Just v) = pure v 135 | liftMaybe (Nothing) = mzero 136 | 137 | -- | Ensures that a maybe value satisfies a given predicate. 138 | ensure :: (a -> Bool) -> a -> Maybe a 139 | ensure p v | p v = Just v 140 | | otherwise = Nothing 141 | 142 | -- | A read-based parser for the 'parser' modifier. 143 | readP :: Read a => String -> Maybe a 144 | readP = fmap fst . listToMaybe . reads 145 | -------------------------------------------------------------------------------- /System/Console/Wizard/BasicIO.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-} 2 | module System.Console.Wizard.BasicIO 3 | ( BasicIO 4 | , basicIO 5 | ) where 6 | import System.Console.Wizard 7 | import System.Console.Wizard.Internal 8 | import Control.Monad.Trans 9 | import Control.Monad.Trans.Maybe 10 | 11 | instance Run IO Output where runAlgebra (Output s w) = putStr s >> w 12 | instance Run IO OutputLn where runAlgebra (OutputLn s w) = putStrLn s >> w 13 | instance Run IO Line where runAlgebra (Line s w) = getLine >>= w 14 | instance Run IO Character where runAlgebra (Character s w) = getChar >>= w 15 | instance Run IO ArbitraryIO where runAlgebra (ArbitraryIO iov f) = iov >>= f 16 | 17 | -- | The 'BasicIO' backend supports only simple input and output. 18 | -- Support for 'Password' and 'LinePrewritten' features can be added with 19 | -- a shim from 'System.Console.Wizard.Shim'. 20 | newtype BasicIO a = BasicIO (( Output 21 | :+: OutputLn 22 | :+: Line 23 | :+: Character 24 | :+: ArbitraryIO) a) 25 | deriving ( (:<:) Output 26 | , (:<:) OutputLn 27 | , (:<:) Line 28 | , (:<:) Character 29 | , (:<:) ArbitraryIO 30 | , Functor 31 | , Run IO 32 | ) 33 | 34 | -- | A simple identity function, used to restrict types if the type inferred by GHC is too general. 35 | -- You could achieve the same effect with a type signature, but this is slightly less typing. 36 | basicIO :: Wizard BasicIO a -> Wizard BasicIO a 37 | basicIO = id 38 | -------------------------------------------------------------------------------- /System/Console/Wizard/Haskeline.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy #-} 2 | module System.Console.Wizard.Haskeline 3 | ( UnexpectedEOF (..) 4 | , Haskeline 5 | , haskeline 6 | , withSettings 7 | , WithSettings(..) 8 | ) where 9 | import System.Console.Wizard 10 | import System.Console.Wizard.Internal 11 | import System.Console.Haskeline 12 | import Control.Monad.Trans 13 | import Control.Monad.Trans.Maybe 14 | import Control.Exception 15 | import Data.Typeable 16 | 17 | 18 | -- | The Haskeline back-end will throw this exception if EOF is encountered 19 | -- when it is not expected. Specifically, when actions such as 'getInputLine' return 'Nothing'. 20 | data UnexpectedEOF = UnexpectedEOF deriving (Show, Typeable) 21 | instance Exception UnexpectedEOF 22 | 23 | -- | Haskeline supports all the following features completely. 24 | newtype Haskeline a = Haskeline (( Output 25 | :+: OutputLn 26 | :+: Line 27 | :+: Character 28 | :+: LinePrewritten 29 | :+: Password 30 | :+: ArbitraryIO 31 | :+: WithSettings) a) 32 | deriving ( (:<:) Output 33 | , (:<:) OutputLn 34 | , (:<:) Line 35 | , (:<:) Character 36 | , (:<:) LinePrewritten 37 | , (:<:) Password 38 | , (:<:) ArbitraryIO 39 | , (:<:) WithSettings 40 | , Functor 41 | , Run (InputT IO) 42 | ) 43 | 44 | -- | Modifies a wizard so that it will run with different Haskeline 'Settings' to the top level input monad. 45 | withSettings :: (WithSettings :<: b) => Settings IO -> Wizard b a -> Wizard b a 46 | withSettings sets (Wizard (MaybeT v)) = Wizard $ MaybeT $ inject (WithSettings sets v) 47 | 48 | data WithSettings w = WithSettings (Settings IO) w deriving (Functor) 49 | 50 | instance Run (InputT IO) Output where runAlgebra (Output s w) = outputStr s >> w 51 | instance Run (InputT IO) OutputLn where runAlgebra (OutputLn s w) = outputStrLn s >> w 52 | instance Run (InputT IO) Line where runAlgebra (Line s w) = getInputLine s >>= mEof w 53 | instance Run (InputT IO) Character where runAlgebra (Character s w) = getInputChar s >>= mEof w 54 | instance Run (InputT IO) LinePrewritten where runAlgebra (LinePrewritten p s1 s2 w) = getInputLineWithInitial p (s1,s2) >>= mEof w 55 | instance Run (InputT IO) Password where runAlgebra (Password p mc w) = getPassword mc p >>= mEof w 56 | instance Run (InputT IO) ArbitraryIO where runAlgebra (ArbitraryIO iov f) = liftIO iov >>= f 57 | instance Run (InputT IO) WithSettings where runAlgebra (WithSettings sets w) = liftIO (runInputT sets w) 58 | 59 | mEof = maybe (throw UnexpectedEOF) 60 | 61 | 62 | -- | A simple identity function, used to restrict types if the type inferred by GHC is too general. 63 | -- You could achieve the same effect with a type signature, but this is slightly less typing. 64 | haskeline :: Wizard Haskeline a -> Wizard Haskeline a 65 | haskeline = id 66 | 67 | -------------------------------------------------------------------------------- /System/Console/Wizard/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor, FlexibleContexts, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy, ExistentialQuantification, EmptyDataDecls #-} 2 | module System.Console.Wizard.Internal ( Wizard (..) 3 | , PromptString (..) 4 | , (:+:) (..) 5 | , (:<:) 6 | , inject 7 | , Run (..) 8 | , run 9 | -- $functors 10 | , Output (..) 11 | , OutputLn (..) 12 | , Line (..) 13 | , LinePrewritten (..) 14 | , Password (..) 15 | , Character (..) 16 | , ArbitraryIO (..) 17 | -- $backend 18 | ) where 19 | import Control.Monad.Free 20 | import Control.Monad.Trans.Maybe 21 | import Control.Applicative 22 | 23 | -- | A string for a prompt 24 | type PromptString = String 25 | 26 | -- | 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. 27 | -- A 'Wizard' is made up of one or more \"primitives\" (see below), composed using the 'Applicative', 28 | -- 'Monad' and 'Alternative' instances. The 'Alternative' instance is, as you might expect, a maybe-style cascade. 29 | -- If the first wizard fails, the next one is tried. `mzero` can be used to induce failure directly. 30 | -- 31 | -- The 'Wizard' constructor is exported here for use when developing backends, but it is better for end-users to 32 | -- simply pretend that 'Wizard' is an opaque data type. Don't depend on this unless you have no other choice. 33 | -- 34 | -- 'Wizard's are, internally, just a maybe transformer over a free monad built from some coproduct of functors, 35 | -- each of which is a primitive action. 36 | newtype Wizard backend a = Wizard (MaybeT (Free backend) a) 37 | deriving (Monad, Functor, Applicative, Alternative, MonadPlus) 38 | 39 | -- | Coproduct of two functors 40 | data (f :+: g) w = Inl (f w) | Inr (g w) deriving Functor 41 | 42 | -- | Subsumption of two functors. You shouldn't define any of your own instances of this when writing back-ends, rely only on GeneralizedNewtypeDeriving. 43 | class (Functor sub, Functor sup) => sub :<: sup where 44 | inj :: sub a -> sup a 45 | 46 | instance Functor f => f :<: f where inj = id 47 | instance (Functor f, Functor g) => f :<: (f :+: g) where inj = Inl 48 | instance (Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where inj = Inr . inj 49 | 50 | -- | Injection function for free monads, see \"Data Types a la Carte\" from Walter Swierstra, @http:\/\/www.cs.ru.nl\/~W.Swierstra\/Publications\/DataTypesALaCarte.pdf@ 51 | inject :: (g :<: f ) => g (Free f a) -> Free f a 52 | inject = Impure . inj 53 | 54 | -- | A class for implementing actions on a backend. E.g Run IO Output provides an interpreter for the Output action in the IO monad. 55 | class Run a b where 56 | runAlgebra :: b (a v) -> a v 57 | 58 | instance (Run b f, Run b g) => Run b (f :+: g) where 59 | runAlgebra (Inl r) = runAlgebra r 60 | runAlgebra (Inr r) = runAlgebra r 61 | 62 | infixr 9 :+: 63 | 64 | -- $functors 65 | -- Each of the following functors is a primitive action. A back-end provides interpreters for these actions using the 'Run' class, 66 | 67 | data Output w = Output String w deriving Functor 68 | data OutputLn w = OutputLn String w deriving Functor 69 | data Line w = Line PromptString (String -> w) deriving Functor 70 | data Character w = Character PromptString (Char -> w) deriving Functor 71 | data LinePrewritten w = LinePrewritten PromptString String String (String -> w) deriving Functor 72 | data Password w = Password PromptString (Maybe Char) (String -> w) deriving Functor 73 | data ArbitraryIO w = forall a. ArbitraryIO (IO a) (a -> w) 74 | instance Functor (ArbitraryIO) where 75 | fmap f (ArbitraryIO iov f') = ArbitraryIO iov (fmap f f') 76 | 77 | 78 | 79 | run' :: (Functor f, Monad b, Run b f) => Free f a -> b a 80 | run' = foldFree return runAlgebra 81 | 82 | -- | Run a wizard using some back-end. 83 | run :: (Functor f, Monad b, Run b f) => Wizard f a -> b (Maybe a) 84 | run (Wizard c) = run' (runMaybeT c) 85 | 86 | 87 | -- $backend 88 | -- A short tutorial on writing backends. 89 | -- 90 | -- Backends consist of two main components: 91 | -- 92 | -- 1. A monad, @M@, in which the primitive actions are interpreted. 'Run' instances specify an interpreter for each supported 93 | -- action, e.g @Run M Output@ will specify an interpreter for the 'Output' primitive action in the monad M. 94 | -- 95 | -- 2. A newtype, e.g @Backend a@, which is a functor, usually implemented by wrapping a coproduct of all supported features. 96 | -- '(:<:)' instances, the 'Functor' instance, and the 'Run' instance are provided by generalized newtype deriving. 97 | -- 98 | -- 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, 99 | -- and arbitrary IO, so I declare instances for 'Run' for the 'IO' monad: 100 | -- 101 | -- @ 102 | -- instance Run IO Output where runAlgebra (Output s w) = putStr s >> w 103 | -- instance Run IO OutputLn where runAlgebra (OutputLn s w) = putStrLn s >> w 104 | -- instance Run IO Line where runAlgebra (Line s w) = getLine >>= w 105 | -- instance Run IO Character where runAlgebra (Character s w) = getChar >>= w 106 | -- instance Run IO ArbitraryIO where runAlgebra (ArbitraryIO iov f) = iov >>= f 107 | -- @ 108 | -- 109 | -- And then I would define the newtype for the backend, which we can call @MyIOBackend@: 110 | -- 111 | -- @ 112 | -- newtype MyIOBackend a = MyIOBackend ((Output :+: OutputLn :+: Line :+: Character :+: ArbitraryIO) a) 113 | -- deriving ( Functor, Run IO 114 | -- , (:<:) Output 115 | -- , (:<:) OutputLn 116 | -- , (:<:) Line 117 | -- , (:<:) Character 118 | -- , (:<:) ArbitraryIO 119 | -- ) 120 | -- @ 121 | -- 122 | -- A useful convenience is to provide a simple identity function to serve as a type coercion: 123 | -- 124 | -- @ 125 | -- myIOBackend :: Wizard MyIOBackend a -> Wizard MyIOBackend a 126 | -- myIOBackend = id 127 | -- @ 128 | -- 129 | -- One additional primitive action that I might want to include is the ability to clear the screen at a certain point. 130 | -- So, we define a new data type for the action: 131 | -- 132 | -- @ 133 | -- data ClearScreen w = ClearScreen w deriving Functor -- via -XDeriveFunctor 134 | -- @ 135 | -- 136 | -- And a \"smart\" constructor for use by the user: 137 | -- 138 | -- @ 139 | -- clearScreen :: (ClearScreen :\<: b) => Wizard b () 140 | -- clearScreen = Wizard $ lift $ inject (ClearScreen (Pure ())) 141 | -- @ 142 | -- 143 | -- (These smart constructors all follow a similar pattern. See the source of "System.Console.Wizard" for more examples) 144 | -- 145 | -- And then we define an interpreter for it: 146 | -- 147 | -- @ 148 | -- instance Run IO ArbitraryIO where runAlgebra (ClearScreen f) = clearTheScreen >> f 149 | -- @ 150 | -- 151 | -- Now, we can use this as-is simply by directly extending our back-end: 152 | -- 153 | -- @ 154 | -- foo :: Wizard (ClearScreen :+: MyIOBackend) 155 | -- foo = clearScreen >> output \"Hello World!\" 156 | -- @ 157 | -- 158 | -- Or, we could modify @MyIOBackend@ to include the extension directly. 159 | -- 160 | -- 161 | -- For custom actions that /return/ output, the definition looks slightly different. Here is the definition of Line: 162 | -- 163 | -- @ 164 | -- data Line w = Line (PromptString) (String -> w) deriving Functor -- via -XDeriveFunctor 165 | -- @ 166 | -- 167 | -- And the smart constructor looks like this: 168 | -- 169 | -- @ 170 | -- line :: (Line :\<: b) => PromptString -> Wizard b String 171 | -- line s = Wizard $ lift $ inject (Line s Pure) 172 | -- @ -------------------------------------------------------------------------------- /System/Console/Wizard/Pure.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, FlexibleInstances, TypeOperators, DoAndIfThenElse, GeneralizedNewtypeDeriving, Trustworthy #-} 2 | module System.Console.Wizard.Pure 3 | ( Pure 4 | , UnexpectedEOI (..) 5 | , runPure 6 | , PureState (..) 7 | ) where 8 | 9 | import System.Console.Wizard 10 | import System.Console.Wizard.Internal 11 | import Control.Monad.Trans 12 | import Control.Monad.State.Lazy 13 | import Control.Monad.Trans.Maybe 14 | import Control.Applicative((<$>)) 15 | import Data.Typeable 16 | import Data.Sequence(Seq, (|>), (><), fromList, empty) 17 | import Control.Monad 18 | import Control.Exception 19 | import Control.Arrow 20 | import Data.Foldable(toList) 21 | 22 | -- | Thrown if the wizard ever unexpectedly runs out of input. 23 | data UnexpectedEOI = UnexpectedEOI deriving (Show, Typeable) 24 | instance Exception UnexpectedEOI 25 | 26 | -- | The pure backend is actually just a simple state monad, with the following state. 27 | type PureState = ([String], Seq Char) 28 | 29 | -- | Run a wizard in the Pure backend 30 | runPure :: Wizard Pure a -> String -> (Maybe a, String) 31 | runPure wz input = let (a,(_,o)) = runState (run wz) (lines input, empty) 32 | in (a, toList o) 33 | 34 | getPureLine :: State PureState String 35 | getPureLine = do crashIfNull 36 | x <- head . fst <$> get 37 | modify (first tail) 38 | return x 39 | 40 | crashIfNull :: State PureState () 41 | crashIfNull = do (x, y ) <- get 42 | when (null x) $ throw UnexpectedEOI 43 | 44 | getPureChar :: State PureState Char 45 | getPureChar = do crashIfNull 46 | x <- null . head . fst <$> get 47 | if x then do 48 | modify (first tail) 49 | return '\n' 50 | else do 51 | r <- head . head . fst <$> get 52 | modify (first (\ (x : r) -> tail x : r)) 53 | return r 54 | 55 | outputPure :: String -> State PureState () 56 | outputPure s = modify (second (>< fromList s)) 57 | >> modify (\s -> s `seq` s) 58 | 59 | outputLnPure :: String -> State PureState () 60 | outputLnPure s = modify (second $ (|> '\n') . (>< fromList s)) 61 | >> modify (\s -> s `seq` s) 62 | 63 | 64 | instance Run (State PureState) Output where runAlgebra (Output s w) = outputPure s >> w 65 | instance Run (State PureState) OutputLn where runAlgebra (OutputLn s w) = outputLnPure s >> w 66 | instance Run (State PureState) Line where runAlgebra (Line s w) = getPureLine >>= w 67 | instance Run (State PureState) Character where runAlgebra (Character s w) = getPureChar >>= w 68 | 69 | -- | The 'Pure' backend supports only simple input and output. 70 | -- Support for 'Password' and 'LinePrewritten' features can be added with 71 | -- a shim from "System.Console.Wizard.Shim". 72 | newtype Pure a = Pure ((Output :+: OutputLn :+: Line :+: Character) a) 73 | deriving ( (:<:) Output 74 | , (:<:) OutputLn 75 | , (:<:) Line 76 | , (:<:) Character 77 | , Functor 78 | , Run (State PureState) 79 | ) 80 | 81 | -------------------------------------------------------------------------------- /System/Console/Wizard/Shim.hs: -------------------------------------------------------------------------------- 1 | module System.Console.Wizard.Shim ( module System.Console.Wizard.Shim.LinePrewritten 2 | , module System.Console.Wizard.Shim.Password 3 | ) where 4 | import System.Console.Wizard.Shim.LinePrewritten 5 | import System.Console.Wizard.Shim.Password 6 | 7 | -------------------------------------------------------------------------------- /System/Console/Wizard/Shim/LinePrewritten.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, Trustworthy #-} 2 | module System.Console.Wizard.Shim.LinePrewritten ( -- $module 3 | ) where 4 | import System.Console.Wizard.Internal 5 | -- $module 6 | -- This module exports a shim instance of 'Run' to make all back-ends that support 'Line' support 'LinePrewritten' 7 | -- simply by ignoring the default text. 8 | -- Don't import this if you're using a back-end that already supports 'LinePrewritten'. 9 | instance (Run m Line) => Run m LinePrewritten where runAlgebra (LinePrewritten p s1 s2 w) = runAlgebra (Line p w) -------------------------------------------------------------------------------- /System/Console/Wizard/Shim/Password.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, Trustworthy #-} 2 | module System.Console.Wizard.Shim.Password ( -- $module 3 | ) where 4 | 5 | import System.Console.Wizard.Internal 6 | -- $module 7 | -- This module exports a shim instance of 'Run' to make all back-ends that support 'Line' support 'Password' 8 | -- simply by ignoring the mask character and reading input with 'Line'. 9 | -- Don't import this if you're using a back-end that already supports 'Password'. 10 | instance (Run m Line) => Run m Password where runAlgebra (Password p mc w) = runAlgebra (Line p w) 11 | -------------------------------------------------------------------------------- /Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances, TypeOperators, FlexibleContexts #-} 2 | import System.Console.Wizard 3 | import System.Console.Wizard.BasicIO 4 | import System.Console.Wizard.Shim 5 | import Control.Applicative 6 | import Control.Monad 7 | import Control.Monad.Trans 8 | import Data.Monoid 9 | 10 | passwordW :: (Password :<: b, OutputLn :<: b) => String -> Wizard b () 11 | passwordW realPassword = 12 | let 13 | w = do validator (== realPassword) $ password "Enter password: " (Just '*') 14 | outputLn "The secret is 42" 15 | in w <|> w <|> w <|> outputLn "Password rejected. Goodbye!" 16 | 17 | main = void $ run $ (passwordW "rosebud" :: Wizard (Password :+: BasicIO) ()) -------------------------------------------------------------------------------- /wizards.cabal: -------------------------------------------------------------------------------- 1 | -- wizards.cabal auto-generated by cabal init. For additional options, 2 | -- see 3 | -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. 4 | -- The name of the package. 5 | Name: wizards 6 | 7 | -- The package version. See the Haskell package versioning policy 8 | -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for 9 | -- standards guiding when and how versions should be incremented. 10 | Version: 1.0.3 11 | 12 | -- A short (one-line) description of the package. 13 | Synopsis: High level, generic library for interrogative user interfaces 14 | 15 | -- A longer description of the package. 16 | -- Description: 17 | 18 | -- The license under which the package is released. 19 | License: BSD3 20 | 21 | -- The file containing the license text. 22 | License-file: LICENSE 23 | 24 | -- The package author(s). 25 | Author: Liam O'Connor-Davis 26 | 27 | -- An email address to which users can send suggestions, bug reports, 28 | -- and patches. 29 | Maintainer: liamoc@cse.unsw.edu.au 30 | 31 | 32 | Description: @wizards@ is a package designed for the quick and painless development of /interrogative/ programs, which 33 | revolve around a \"dialogue\" with the user, who is asked a series of questions in a sequence much like an 34 | installation wizard. 35 | . 36 | Everything from interactive system scripts, to installation wizards, to full-blown shells can be implemented with 37 | the support of @wizards@. 38 | . 39 | It is developed transparently on top of a free monad, which separates out the semantics of the program from any 40 | particular interface. A variety of backends exist, including console-based "System.Console.Wizard.Haskeline" and 41 | "System.Console.Wizard.BasicIO", and the pure "System.Console.Wizard.Pure". It is also possible to write your 42 | own backends, or extend existing back-ends with new features. While both built-in IO backends operate on a 43 | console, there is no reason why @wizards@ cannot also be used for making GUI wizard interfaces. 44 | . 45 | . 46 | See the github page for examples on usage: 47 | . 48 | 49 | . 50 | For creating backends, the module "System.Console.Wizard.Internal" has a brief tutorial. 51 | 52 | -- A copyright notice. 53 | -- Copyright: 54 | 55 | Category: User Interfaces 56 | 57 | Build-type: Simple 58 | 59 | -- Extra files to be distributed with the package, such as examples or 60 | -- a README. 61 | -- Extra-source-files: 62 | 63 | -- Constraint on the version of Cabal needed to build this package. 64 | Cabal-version: >=1.6 65 | 66 | source-repository head 67 | type: git 68 | location: git://github.com/liamoc/wizards.git 69 | 70 | source-repository this 71 | type: git 72 | location: git://github.com/liamoc/wizards.git 73 | tag: 1.0 74 | 75 | 76 | Library 77 | -- Modules exported by the library. 78 | Exposed-modules: System.Console.Wizard 79 | System.Console.Wizard.Internal 80 | System.Console.Wizard.Haskeline 81 | System.Console.Wizard.BasicIO 82 | System.Console.Wizard.Pure 83 | Extensions: OverlappingInstances 84 | 85 | -- Packages needed in order to build this package. 86 | Build-depends: base == 4.*, haskeline >= 0.6 && < 0.8, mtl >= 2.0 && < 2.3, transformers >= 0.1 && < 0.6, control-monad-free >= 0.5 && < 0.7, containers >= 0.4 && < 0.7 87 | 88 | -- Modules not exported by this package. 89 | -- Other-modules: 90 | 91 | -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. 92 | -- Build-tools: 93 | 94 | --------------------------------------------------------------------------------