{-# LANGUAGE FlexibleContexts, TypeOperators, Trustworthy #-}
{-# LANGUAGE UndecidableInstances #-}
module System.Console.Wizard
(
Wizard (..)
, PromptString (..)
, run
, (:<:)
, (:+:)
, Line
, line
, LinePrewritten
, linePrewritten
, Password
, password
, Character
, character
, Output
, output
, OutputLn
, outputLn
, ArbitraryIO
, retry
, retryMsg
, defaultTo
, parser
, validator
, nonEmpty
, inRange
, parseRead
, 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
output :: (Output :<: b) => String -> Wizard b ()
output :: forall (b :: * -> *). (Output :<: b) => String -> Wizard b ()
output String
s = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w. String -> w -> Output w
Output String
s (forall (f :: * -> *) a. a -> Free f a
Pure ()))
outputLn :: (OutputLn :<: b) => String -> Wizard b ()
outputLn :: forall (b :: * -> *). (OutputLn :<: b) => String -> Wizard b ()
outputLn String
s = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w. String -> w -> OutputLn w
OutputLn String
s (forall (f :: * -> *) a. a -> Free f a
Pure ()))
line :: (Line :<: b) => PromptString -> Wizard b String
line :: forall (b :: * -> *). (Line :<: b) => String -> Wizard b String
line String
s = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w. String -> (String -> w) -> Line w
Line String
s forall (f :: * -> *) a. a -> Free f a
Pure)
character :: (Character :<: b)
=> PromptString
-> Wizard b Char
character :: forall (b :: * -> *). (Character :<: b) => String -> Wizard b Char
character String
p = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w. String -> (Char -> w) -> Character w
Character String
p forall (f :: * -> *) a. a -> Free f a
Pure)
instance (ArbitraryIO :<: b) => MonadIO (Wizard b) where
liftIO :: forall a. IO a -> Wizard b a
liftIO IO a
v = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w a. IO a -> (a -> w) -> ArbitraryIO w
ArbitraryIO IO a
v forall (f :: * -> *) a. a -> Free f a
Pure)
linePrewritten :: (LinePrewritten :<: b)
=> PromptString
-> String
-> String
-> Wizard b String
linePrewritten :: forall (b :: * -> *).
(LinePrewritten :<: b) =>
String -> String -> String -> Wizard b String
linePrewritten String
p String
s1 String
s2 = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w.
String -> String -> String -> (String -> w) -> LinePrewritten w
LinePrewritten String
p String
s1 String
s2 forall (f :: * -> *) a. a -> Free f a
Pure)
password :: (Password :<: b)
=> PromptString
-> Maybe Char
-> Wizard b String
password :: forall (b :: * -> *).
(Password :<: b) =>
String -> Maybe Char -> Wizard b String
password String
p Maybe Char
mc = forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (forall w. String -> Maybe Char -> (String -> w) -> Password w
Password String
p Maybe Char
mc forall (f :: * -> *) a. a -> Free f a
Pure)
retry :: Functor b => Wizard b a -> Wizard b a
retry :: forall (b :: * -> *) a. Functor b => Wizard b a -> Wizard b a
retry Wizard b a
x = Wizard b a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (b :: * -> *) a. Functor b => Wizard b a -> Wizard b a
retry Wizard b a
x
retryMsg :: (OutputLn :<: b) => String -> Wizard b a -> Wizard b a
retryMsg :: forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
msg Wizard b a
x = Wizard b a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (b :: * -> *). (OutputLn :<: b) => String -> Wizard b ()
outputLn String
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (b :: * -> *) a.
(OutputLn :<: b) =>
String -> Wizard b a -> Wizard b a
retryMsg String
msg Wizard b a
x)
defaultTo :: Functor b => Wizard b a -> a -> Wizard b a
defaultTo :: forall (b :: * -> *) a. Functor b => Wizard b a -> a -> Wizard b a
defaultTo Wizard b a
wz a
d = Wizard b a
wz forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
d
parser :: Functor b => (a -> Maybe c) -> Wizard b a -> Wizard b c
parser :: forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser a -> Maybe c
f Wizard b a
a = Wizard b a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (b :: * -> *) a. Functor b => Maybe a -> Wizard b a
liftMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe c
f
validator :: Functor b => (a -> Bool) -> Wizard b a -> Wizard b a
validator :: forall (b :: * -> *) a.
Functor b =>
(a -> Bool) -> Wizard b a -> Wizard b a
validator = forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> a -> Maybe a
ensure
nonEmpty :: Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty :: forall (b :: * -> *) a. Functor b => Wizard b [a] -> Wizard b [a]
nonEmpty = forall (b :: * -> *) a.
Functor b =>
(a -> Bool) -> Wizard b a -> Wizard b a
validator (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
inRange :: (Ord a, Functor b) => (a,a) -> Wizard b a -> Wizard b a
inRange :: forall a (b :: * -> *).
(Ord a, Functor b) =>
(a, a) -> Wizard b a -> Wizard b a
inRange (a
b,a
t) = forall (b :: * -> *) a.
Functor b =>
(a -> Bool) -> Wizard b a -> Wizard b a
validator (\a
x -> a
b forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
<= a
t)
parseRead :: (Read a, Functor b) => Wizard b String -> Wizard b a
parseRead :: forall a (b :: * -> *).
(Read a, Functor b) =>
Wizard b String -> Wizard b a
parseRead = forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (forall a. Read a => String -> Maybe a
readP)
liftMaybe :: Functor b => Maybe a -> Wizard b a
liftMaybe :: forall (b :: * -> *) a. Functor b => Maybe a -> Wizard b a
liftMaybe (Just a
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
liftMaybe (Maybe a
Nothing) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
ensure :: (a -> Bool) -> a -> Maybe a
ensure :: forall a. (a -> Bool) -> a -> Maybe a
ensure a -> Bool
p a
v | a -> Bool
p a
v = forall a. a -> Maybe a
Just a
v
| Bool
otherwise = forall a. Maybe a
Nothing
readP :: Read a => String -> Maybe a
readP :: forall a. Read a => String -> Maybe a
readP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => ReadS a
reads