{-# 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 = MaybeT (Free b) () -> Wizard b ()
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) () -> Wizard b ())
-> MaybeT (Free b) () -> Wizard b ()
forall a b. (a -> b) -> a -> b
$ Free b () -> MaybeT (Free b) ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b () -> MaybeT (Free b) ())
-> Free b () -> MaybeT (Free b) ()
forall a b. (a -> b) -> a -> b
$ Output (Free b ()) -> Free b ()
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String -> Free b () -> Output (Free b ())
forall w. String -> w -> Output w
Output String
s (() -> Free b ()
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 = MaybeT (Free b) () -> Wizard b ()
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) () -> Wizard b ())
-> MaybeT (Free b) () -> Wizard b ()
forall a b. (a -> b) -> a -> b
$ Free b () -> MaybeT (Free b) ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b () -> MaybeT (Free b) ())
-> Free b () -> MaybeT (Free b) ()
forall a b. (a -> b) -> a -> b
$ OutputLn (Free b ()) -> Free b ()
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String -> Free b () -> OutputLn (Free b ())
forall w. String -> w -> OutputLn w
OutputLn String
s (() -> Free b ()
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 = MaybeT (Free b) String -> Wizard b String
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) String -> Wizard b String)
-> MaybeT (Free b) String -> Wizard b String
forall a b. (a -> b) -> a -> b
$ Free b String -> MaybeT (Free b) String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b String -> MaybeT (Free b) String)
-> Free b String -> MaybeT (Free b) String
forall a b. (a -> b) -> a -> b
$ Line (Free b String) -> Free b String
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String -> (String -> Free b String) -> Line (Free b String)
forall w. String -> (String -> w) -> Line w
Line String
s String -> Free b String
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 = MaybeT (Free b) Char -> Wizard b Char
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) Char -> Wizard b Char)
-> MaybeT (Free b) Char -> Wizard b Char
forall a b. (a -> b) -> a -> b
$ Free b Char -> MaybeT (Free b) Char
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b Char -> MaybeT (Free b) Char)
-> Free b Char -> MaybeT (Free b) Char
forall a b. (a -> b) -> a -> b
$ Character (Free b Char) -> Free b Char
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String -> (Char -> Free b Char) -> Character (Free b Char)
forall w. String -> (Char -> w) -> Character w
Character String
p Char -> Free b Char
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 = MaybeT (Free b) a -> Wizard b a
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) a -> Wizard b a)
-> MaybeT (Free b) a -> Wizard b a
forall a b. (a -> b) -> a -> b
$ Free b a -> MaybeT (Free b) a
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b a -> MaybeT (Free b) a) -> Free b a -> MaybeT (Free b) a
forall a b. (a -> b) -> a -> b
$ ArbitraryIO (Free b a) -> Free b a
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (IO a -> (a -> Free b a) -> ArbitraryIO (Free b a)
forall w a. IO a -> (a -> w) -> ArbitraryIO w
ArbitraryIO IO a
v a -> Free b a
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 = MaybeT (Free b) String -> Wizard b String
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) String -> Wizard b String)
-> MaybeT (Free b) String -> Wizard b String
forall a b. (a -> b) -> a -> b
$ Free b String -> MaybeT (Free b) String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b String -> MaybeT (Free b) String)
-> Free b String -> MaybeT (Free b) String
forall a b. (a -> b) -> a -> b
$ LinePrewritten (Free b String) -> Free b String
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String
-> String
-> String
-> (String -> Free b String)
-> LinePrewritten (Free b String)
forall w.
String -> String -> String -> (String -> w) -> LinePrewritten w
LinePrewritten String
p String
s1 String
s2 String -> Free b String
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 = MaybeT (Free b) String -> Wizard b String
forall (backend :: * -> *) a.
MaybeT (Free backend) a -> Wizard backend a
Wizard (MaybeT (Free b) String -> Wizard b String)
-> MaybeT (Free b) String -> Wizard b String
forall a b. (a -> b) -> a -> b
$ Free b String -> MaybeT (Free b) String
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Free b String -> MaybeT (Free b) String)
-> Free b String -> MaybeT (Free b) String
forall a b. (a -> b) -> a -> b
$ Password (Free b String) -> Free b String
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject (String
-> Maybe Char
-> (String -> Free b String)
-> Password (Free b String)
forall w. String -> Maybe Char -> (String -> w) -> Password w
Password String
p Maybe Char
mc String -> Free b String
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 Wizard b a -> Wizard b a -> Wizard b a
forall a. Wizard b a -> Wizard b a -> Wizard b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Wizard b a -> Wizard b 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 Wizard b a -> Wizard b a -> Wizard b a
forall a. Wizard b a -> Wizard b a -> Wizard b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Wizard b ()
forall (b :: * -> *). (OutputLn :<: b) => String -> Wizard b ()
outputLn String
msg Wizard b () -> Wizard b a -> Wizard b a
forall a b. Wizard b a -> Wizard b b -> Wizard b b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Wizard b a -> Wizard b a
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 Wizard b a -> Wizard b a -> Wizard b a
forall a. Wizard b a -> Wizard b a -> Wizard b a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Wizard b a
forall a. a -> Wizard b 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 Wizard b a -> (a -> Wizard b c) -> Wizard b c
forall a b. Wizard b a -> (a -> Wizard b b) -> Wizard b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe c -> Wizard b c
forall (b :: * -> *) a. Functor b => Maybe a -> Wizard b a
liftMaybe (Maybe c -> Wizard b c) -> (a -> Maybe c) -> a -> Wizard b c
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 = (a -> Maybe a) -> Wizard b a -> Wizard b a
forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser ((a -> Maybe a) -> Wizard b a -> Wizard b a)
-> ((a -> Bool) -> a -> Maybe a)
-> (a -> Bool)
-> Wizard b a
-> Wizard b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> a -> Maybe a
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 = ([a] -> Bool) -> Wizard b [a] -> Wizard b [a]
forall (b :: * -> *) a.
Functor b =>
(a -> Bool) -> Wizard b a -> Wizard b a
validator (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
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) = (a -> Bool) -> Wizard b a -> Wizard b a
forall (b :: * -> *) a.
Functor b =>
(a -> Bool) -> Wizard b a -> Wizard b a
validator (\a
x -> a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
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 = (String -> Maybe a) -> Wizard b String -> Wizard b a
forall (b :: * -> *) a c.
Functor b =>
(a -> Maybe c) -> Wizard b a -> Wizard b c
parser (String -> Maybe a
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) = a -> Wizard b a
forall a. a -> Wizard b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
liftMaybe (Maybe a
Nothing) = Wizard b a
forall a. Wizard b a
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 = a -> Maybe a
forall a. a -> Maybe a
Just a
v
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
readP :: Read a => String -> Maybe a
readP :: forall a. Read a => String -> Maybe a
readP = ((a, String) -> a) -> Maybe (a, String) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, String) -> a
forall a b. (a, b) -> a
fst (Maybe (a, String) -> Maybe a)
-> (String -> Maybe (a, String)) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, String)] -> Maybe (a, String)
forall a. [a] -> Maybe a
listToMaybe ([(a, String)] -> Maybe (a, String))
-> (String -> [(a, String)]) -> String -> Maybe (a, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. Read a => ReadS a
reads