{-# 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 (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
return :: forall a. a -> Wizard backend a
$creturn :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
>> :: 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 b
>>= :: forall a b.
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
$c>>= :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
Monad, 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
<$ :: forall a b. a -> Wizard backend b -> Wizard backend a
$c<$ :: forall (backend :: * -> *) a b.
Functor backend =>
a -> Wizard backend b -> Wizard backend a
fmap :: forall a b. (a -> b) -> Wizard backend a -> Wizard backend b
$cfmap :: forall (backend :: * -> *) a b.
Functor backend =>
(a -> b) -> Wizard backend a -> Wizard backend b
Functor, 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
<* :: forall a b.
Wizard backend a -> Wizard backend b -> Wizard backend a
$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 b
$c*> :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend a -> Wizard backend b -> Wizard backend b
liftA2 :: forall a b c.
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
$cliftA2 :: forall (backend :: * -> *) a b c.
Functor backend =>
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
<*> :: forall a b.
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
$c<*> :: forall (backend :: * -> *) a b.
Functor backend =>
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
pure :: forall a. a -> Wizard backend a
$cpure :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
Applicative, 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
many :: forall a. Wizard backend a -> Wizard backend [a]
$cmany :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
some :: forall a. Wizard backend a -> Wizard backend [a]
$csome :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
<|> :: forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
$c<|> :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
empty :: forall a. Wizard backend a
$cempty :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
Alternative, 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
mplus :: forall a. Wizard backend a -> Wizard backend a -> Wizard backend a
$cmplus :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend a -> Wizard backend a
mzero :: forall a. Wizard backend a
$cmzero :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
MonadPlus)
data (f :+: g) w = Inl (f w) | Inr (g w) deriving 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
<$ :: forall a b. a -> (:+:) f g b -> (:+:) f g a
$c<$ :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> (:+:) f g b -> (:+:) f g a
fmap :: forall a b. (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
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 = forall a. a -> a
id
instance (Functor f, Functor g) => f :<: (f :+: g) where inj :: forall a. f a -> (:+:) f g a
inj = 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 = forall (f :: * -> *) (g :: * -> *) w. g w -> (:+:) f g w
Inr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (a :: * -> *) (b :: * -> *) v. Run a b => b (a v) -> a v
runAlgebra f (b v)
r
runAlgebra (Inr g (b v)
r) = 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 -> 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
<$ :: forall a b. a -> Output b -> Output a
$c<$ :: forall a b. a -> Output b -> Output a
fmap :: forall a b. (a -> b) -> Output a -> Output b
$cfmap :: forall a b. (a -> b) -> Output a -> Output b
Functor
data OutputLn w = OutputLn String w deriving 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
<$ :: forall a b. a -> OutputLn b -> OutputLn a
$c<$ :: forall a b. a -> OutputLn b -> OutputLn a
fmap :: forall a b. (a -> b) -> OutputLn a -> OutputLn b
$cfmap :: forall a b. (a -> b) -> OutputLn a -> OutputLn b
Functor
data Line w = Line PromptString (String -> w) deriving 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
<$ :: forall a b. a -> Line b -> Line a
$c<$ :: forall a b. a -> Line b -> Line a
fmap :: forall a b. (a -> b) -> Line a -> Line b
$cfmap :: forall a b. (a -> b) -> Line a -> Line b
Functor
data Character w = Character PromptString (Char -> w) deriving 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
<$ :: forall a b. a -> Character b -> Character a
$c<$ :: forall a b. a -> Character b -> Character a
fmap :: forall a b. (a -> b) -> Character a -> Character b
$cfmap :: forall a b. (a -> b) -> Character a -> Character b
Functor
data LinePrewritten w = LinePrewritten PromptString String String (String -> w) deriving 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
<$ :: forall a b. a -> LinePrewritten b -> LinePrewritten a
$c<$ :: forall a b. a -> LinePrewritten b -> LinePrewritten a
fmap :: forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b
$cfmap :: forall a b. (a -> b) -> LinePrewritten a -> LinePrewritten b
Functor
data Password w = Password PromptString (Maybe Char) (String -> w) deriving 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
<$ :: forall a b. a -> Password b -> Password a
$c<$ :: forall a b. a -> Password b -> Password a
fmap :: forall a b. (a -> b) -> Password a -> Password b
$cfmap :: forall a b. (a -> b) -> Password a -> Password b
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') = forall w a. IO a -> (a -> w) -> ArbitraryIO w
ArbitraryIO IO a
iov (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' = forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree forall (m :: * -> *) a. Monad m => a -> m a
return 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) = forall (f :: * -> *) (b :: * -> *) a.
(Functor f, Monad b, Run b f) =>
Free f a -> b a
run' (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (Free f) a
c)