{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveFunctor, FlexibleContexts, TypeOperators, GeneralizedNewtypeDeriving, Trustworthy, ExistentialQuantification, EmptyDataDecls #-}
module System.Console.Wizard.Internal ( Wizard (..)
, PromptString (..)
, (:+:) (..)
, (:<:)
, inject
, Run (..)
, run
, Output (..)
, OutputLn (..)
, Line (..)
, LinePrewritten (..)
, Password (..)
, Character (..)
, ArbitraryIO (..)
) where
import Control.Monad.Free
import Control.Monad.Trans.Maybe
import Control.Applicative
type PromptString = String
newtype Wizard backend a = Wizard (MaybeT (Free backend) a)
deriving (Applicative (Wizard backend)
Applicative (Wizard backend)
-> (forall a b.
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b)
-> (forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b)
-> (forall a. a -> Wizard backend a)
-> Monad (Wizard backend)
forall a. a -> Wizard backend a
forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b
forall a b.
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
forall {backend :: * -> *}.
Functor backend =>
Applicative (Wizard backend)
forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend b
forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
>>= :: forall a b.
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
$c>> :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend b
>> :: forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b
$creturn :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
return :: forall a. a -> Wizard backend a
Monad, (forall a b. (a -> b) -> Wizard backend a -> Wizard backend b)
-> (forall a b. a -> Wizard backend b -> Wizard backend a)
-> Functor (Wizard backend)
forall a b. a -> Wizard backend b -> Wizard backend a
forall a b. (a -> b) -> Wizard backend a -> Wizard backend b
forall (backend :: * -> *) a b.
Functor backend =>
a -> Wizard backend b -> Wizard backend a
forall (backend :: * -> *) a b.
Functor backend =>
(a -> b) -> Wizard backend a -> Wizard backend b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (backend :: * -> *) a b.
Functor backend =>
(a -> b) -> Wizard backend a -> Wizard backend b
fmap :: forall a b. (a -> b) -> Wizard backend a -> Wizard backend b
$c<$ :: forall (backend :: * -> *) a b.
Functor backend =>
a -> Wizard backend b -> Wizard backend a
<$ :: forall a b. a -> Wizard backend b -> Wizard backend a
Functor, Functor (Wizard backend)
Functor (Wizard backend)
-> (forall a. a -> Wizard backend a)
-> (forall a b.
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b)
-> (forall a b c.
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c)
-> (forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b)
-> (forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend a)
-> Applicative (Wizard backend)
forall a. a -> Wizard backend a
forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend a
forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b
forall a b.
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
forall a b c.
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
forall (backend :: * -> *).
Functor backend =>
Functor (Wizard backend)
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend a
forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend b
forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
forall (backend :: * -> *) a b c.
Functor backend =>
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
$cpure :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
pure :: forall a. a -> Wizard backend a
$c<*> :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
<*> :: forall a b.
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
$cliftA2 :: forall (backend :: * -> *) a b c.
Functor backend =>
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
liftA2 :: forall a b c.
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
$c*> :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend b
*> :: forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend b
$c<* :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend a
<* :: forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend a
Applicative, Applicative (Wizard backend)
Applicative (Wizard backend)
-> (forall a. Wizard backend a)
-> (forall a.
Wizard backend a -> Wizard backend a -> Wizard backend a)
-> (forall a. Wizard backend a -> Wizard backend [a])
-> (forall a. Wizard backend a -> Wizard backend [a])
-> Alternative (Wizard backend)
forall a. Wizard backend a
forall a. Wizard backend a -> Wizard backend [a]
forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
forall {backend :: * -> *}.
Functor backend =>
Applicative (Wizard backend)
forall (backend :: * -> *) a. Functor backend => Wizard backend a
forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
empty :: forall a. Wizard backend a
$c<|> :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
<|> :: forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
$csome :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
some :: forall a. Wizard backend a -> Wizard backend [a]
$cmany :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
many :: forall a. Wizard backend a -> Wizard backend [a]
Alternative, Monad (Wizard backend)
Alternative (Wizard backend)
Alternative (Wizard backend)
-> Monad (Wizard backend)
-> (forall a. Wizard backend a)
-> (forall a.
Wizard backend a -> Wizard backend a -> Wizard backend a)
-> MonadPlus (Wizard backend)
forall a. Wizard backend a
forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
forall (backend :: * -> *).
Functor backend =>
Monad (Wizard backend)
forall (backend :: * -> *).
Functor backend =>
Alternative (Wizard backend)
forall (backend :: * -> *) a. Functor backend => Wizard backend a
forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
$cmzero :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
mzero :: forall a. Wizard backend a
$cmplus :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
mplus :: forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
MonadPlus)
data (f :+: g) w = Inl (f w) | Inr (g w) deriving (forall a b. (a -> b) -> (:+:) f g a -> (:+:) f g b)
-> (forall a b. a -> (:+:) f g b -> (:+:) f g a)
-> Functor (f :+: g)
forall a b. a -> (:+:) f g b -> (:+:) f g a
forall a b. (a -> b) -> (:+:) f g a -> (:+:) f g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> (:+:) f g b -> (:+:) f g a
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> (:+:) f g a -> (:+:) f g b
$cfmap :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> (:+:) f g a -> (:+:) f g b
fmap :: forall a b. (a -> b) -> (:+:) f g a -> (:+:) f g b
$c<$ :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> (:+:) f g b -> (:+:) f g a
<$ :: forall a b. a -> (:+:) f g b -> (:+:) f g a
Functor
class (Functor sub, Functor sup) => sub :<: sup where
inj :: sub a -> sup a
instance Functor f => f :<: f where inj :: forall a. f a -> f a
inj = f a -> f a
forall a. a -> a
id
instance (Functor f, Functor g) => f :<: (f :+: g) where inj :: forall a. f a -> (:+:) f g a
inj = f a -> (:+:) f g a
forall (f :: * -> *) (g :: * -> *) w. f w -> (:+:) f g w
Inl
instance (Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where inj :: forall a. f a -> (:+:) h g a
inj = g a -> (:+:) h g a
forall (f :: * -> *) (g :: * -> *) w. g w -> (:+:) f g w
Inr (g a -> (:+:) h g a) -> (f a -> g a) -> f a -> (:+:) h g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall a. f a -> g a
forall (sub :: * -> *) (sup :: * -> *) a.
(sub :<: sup) =>
sub a -> sup a
inj
inject :: (g :<: f ) => g (Free f a) -> Free f a
inject :: forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
inject = f (Free f a) -> Free f a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (f (Free f a) -> Free f a)
-> (g (Free f a) -> f (Free f a)) -> g (Free f a) -> Free f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (Free f a) -> f (Free f a)
forall a. g a -> f a
forall (sub :: * -> *) (sup :: * -> *) a.
(sub :<: sup) =>
sub a -> sup a
inj
class Run a b where
runAlgebra :: b (a v) -> a v
instance (Run b f, Run b g) => Run b (f :+: g) where
runAlgebra :: forall v. (:+:) f g (b v) -> b v
runAlgebra (Inl f (b v)
r) = f (b v) -> b v
forall v. f (b v) -> b v
forall (a :: * -> *) (b :: * -> *) v. Run a b => b (a v) -> a v
runAlgebra f (b v)
r
runAlgebra (Inr g (b v)
r) = g (b v) -> b v
forall v. g (b v) -> b v
forall (a :: * -> *) (b :: * -> *) v. Run a b => b (a v) -> a v
runAlgebra g (b v)
r
infixr 9 :+:
data Output w = Output String w deriving (forall a b. (a -> b) -> Output a -> Output b)
-> (forall a b. a -> Output b -> Output a) -> Functor Output
forall a b. a -> Output b -> Output a
forall a b. (a -> b) -> Output a -> Output b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Output a -> Output b
fmap :: forall a b. (a -> b) -> Output a -> Output b
$c<$ :: forall a b. a -> Output b -> Output a
<$ :: forall a b. a -> Output b -> Output a
Functor
data OutputLn w = OutputLn String w deriving (forall a b. (a -> b) -> OutputLn a -> OutputLn b)
-> (forall a b. a -> OutputLn b -> OutputLn a) -> Functor OutputLn
forall a b. a -> OutputLn b -> OutputLn a
forall a b. (a -> b) -> OutputLn a -> OutputLn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OutputLn a -> OutputLn b
fmap :: forall a b. (a -> b) -> OutputLn a -> OutputLn b
$c<$ :: forall a b. a -> OutputLn b -> OutputLn a
<$ :: forall a b. a -> OutputLn b -> OutputLn a
Functor
data Line w = Line PromptString (String -> w) deriving (forall a b. (a -> b) -> Line a -> Line b)
-> (forall a b. a -> Line b -> Line a) -> Functor Line
forall a b. a -> Line b -> Line a
forall a b. (a -> b) -> Line a -> Line b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Line a -> Line b
fmap :: forall a b. (a -> b) -> Line a -> Line b
$c<$ :: forall a b. a -> Line b -> Line a
<$ :: forall a b. a -> Line b -> Line a
Functor
data Character w = Character PromptString (Char -> w) deriving (forall a b. (a -> b) -> Character a -> Character b)
-> (forall a b. a -> Character b -> Character a)
-> Functor Character
forall a b. a -> Character b -> Character a
forall a b. (a -> b) -> Character a -> Character b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Character a -> Character b
fmap :: forall a b. (a -> b) -> Character a -> Character b
$c<$ :: forall a b. a -> Character b -> Character a
<$ :: forall a b. a -> Character b -> Character a
Functor
data LinePrewritten w = LinePrewritten PromptString String String (String -> w) deriving (forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b)
-> (forall a b. a -> LinePrewritten b -> LinePrewritten a)
-> Functor LinePrewritten
forall a b. a -> LinePrewritten b -> LinePrewritten a
forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b
fmap :: forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b
$c<$ :: forall a b. a -> LinePrewritten b -> LinePrewritten a
<$ :: forall a b. a -> LinePrewritten b -> LinePrewritten a
Functor
data Password w = Password PromptString (Maybe Char) (String -> w) deriving (forall a b. (a -> b) -> Password a -> Password b)
-> (forall a b. a -> Password b -> Password a) -> Functor Password
forall a b. a -> Password b -> Password a
forall a b. (a -> b) -> Password a -> Password b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Password a -> Password b
fmap :: forall a b. (a -> b) -> Password a -> Password b
$c<$ :: forall a b. a -> Password b -> Password a
<$ :: forall a b. a -> Password b -> Password a
Functor
data ArbitraryIO w = forall a. ArbitraryIO (IO a) (a -> w)
instance Functor (ArbitraryIO) where
fmap :: forall a b. (a -> b) -> ArbitraryIO a -> ArbitraryIO b
fmap a -> b
f (ArbitraryIO IO a
iov a -> a
f') = IO a -> (a -> b) -> ArbitraryIO b
forall w a. IO a -> (a -> w) -> ArbitraryIO w
ArbitraryIO IO a
iov ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
f')
run' :: (Functor f, Monad b, Run b f) => Free f a -> b a
run' :: forall (f :: * -> *) (b :: * -> *) a.
(Functor f, Monad b, Run b f) =>
Free f a -> b a
run' = (a -> b a) -> (f (b a) -> b a) -> Free f a -> b a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> b a
forall a. a -> b a
forall (m :: * -> *) a. Monad m => a -> m a
return f (b a) -> b a
forall v. f (b v) -> b v
forall (a :: * -> *) (b :: * -> *) v. Run a b => b (a v) -> a v
runAlgebra
run :: (Functor f, Monad b, Run b f) => Wizard f a -> b (Maybe a)
run :: forall (f :: * -> *) (b :: * -> *) a.
(Functor f, Monad b, Run b f) =>
Wizard f a -> b (Maybe a)
run (Wizard MaybeT (Free f) a
c) = Free f (Maybe a) -> b (Maybe a)
forall (f :: * -> *) (b :: * -> *) a.
(Functor f, Monad b, Run b f) =>
Free f a -> b a
run' (MaybeT (Free f) a -> Free f (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (Free f) a
c)