1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
{-# 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
|
