{-# 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)
a -> Wizard backend a
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)
Wizard backend a -> (a -> Wizard backend b) -> Wizard backend b
Wizard backend a -> Wizard backend b -> Wizard backend b
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 :: a -> Wizard backend a
$creturn :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
>> :: 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
>>= :: 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
$cp1Monad :: forall (backend :: * -> *).
Functor backend =>
Applicative (Wizard backend)
Monad, a -> Wizard backend b -> Wizard backend a
(a -> b) -> Wizard backend a -> Wizard backend b
(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
<$ :: a -> Wizard backend b -> Wizard backend a
$c<$ :: forall (backend :: * -> *) a b.
Functor backend =>
a -> Wizard backend b -> Wizard backend a
fmap :: (a -> b) -> Wizard backend a -> Wizard backend b
$cfmap :: forall (backend :: * -> *) a b.
Functor backend =>
(a -> b) -> Wizard backend a -> Wizard backend b
Functor, Functor (Wizard backend)
a -> Wizard backend a
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)
Wizard backend a -> Wizard backend b -> Wizard backend b
Wizard backend a -> Wizard backend b -> Wizard backend a
Wizard backend (a -> b) -> Wizard backend a -> Wizard backend b
(a -> b -> c)
-> Wizard backend a -> Wizard backend b -> Wizard backend c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> Wizard backend a
$cpure :: forall (backend :: * -> *) a.
Functor backend =>
a -> Wizard backend a
$cp1Applicative :: forall (backend :: * -> *).
Functor backend =>
Functor (Wizard backend)
Applicative, Applicative (Wizard backend)
Wizard backend a
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)
Wizard backend a -> Wizard backend a -> Wizard backend a
Wizard backend a -> Wizard backend [a]
Wizard backend a -> Wizard backend [a]
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 :: Wizard backend a -> Wizard backend [a]
$cmany :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [a]
some :: Wizard backend a -> Wizard backend [a]
$csome :: forall (backend :: * -> *) a.
Functor backend =>
Wizard backend a -> Wizard backend [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 :: Wizard backend a
$cempty :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
$cp1Alternative :: forall (backend :: * -> *).
Functor backend =>
Applicative (Wizard backend)
Alternative, Monad (Wizard backend)
Alternative (Wizard backend)
Wizard backend a
(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)
Wizard backend a -> Wizard backend a -> Wizard backend a
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 :: 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 :: Wizard backend a
$cmzero :: forall (backend :: * -> *) a. Functor backend => Wizard backend a
$cp2MonadPlus :: forall (backend :: * -> *).
Functor backend =>
Monad (Wizard backend)
$cp1MonadPlus :: forall (backend :: * -> *).
Functor backend =>
Alternative (Wizard backend)
MonadPlus)
data (f :+: g) w = Inl (f w) | Inr (g w) deriving a -> (:+:) f g b -> (:+:) f g a
(a -> b) -> (:+:) f g a -> (:+:) f g b
(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
<$ :: 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 :: (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 :: f a -> f a
inj = f a -> f a
forall a. a -> a
id
instance (Functor f, Functor g) => f :<: (f :+: g) where inj :: 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 :: 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 (sub :: * -> *) (sup :: * -> *) a.
(sub :<: sup) =>
sub a -> sup a
inj
inject :: (g :<: f ) => g (Free f a) -> Free f a
inject :: 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 (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 :: (:+:) f g (b v) -> b v
runAlgebra (Inl r :: f (b v)
r) = f (b v) -> b v
forall (a :: * -> *) (b :: * -> *) v. Run a b => b (a v) -> a v
runAlgebra f (b v)
r
runAlgebra (Inr r :: g (b v)
r) = 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 a -> Output b -> Output a
(a -> b) -> Output a -> Output b
(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
<$ :: a -> Output b -> Output a
$c<$ :: forall a b. a -> Output b -> Output a
fmap :: (a -> b) -> Output a -> Output b
$cfmap :: forall a b. (a -> b) -> Output a -> Output b
Functor
data OutputLn w = OutputLn String w deriving a -> OutputLn b -> OutputLn a
(a -> b) -> OutputLn a -> OutputLn b
(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
<$ :: a -> OutputLn b -> OutputLn a
$c<$ :: forall a b. a -> OutputLn b -> OutputLn a
fmap :: (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 a -> Line b -> Line a
(a -> b) -> Line a -> Line b
(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
<$ :: a -> Line b -> Line a
$c<$ :: forall a b. a -> Line b -> Line a
fmap :: (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 a -> Character b -> Character a
(a -> b) -> Character a -> Character b
(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
<$ :: a -> Character b -> Character a
$c<$ :: forall a b. a -> Character b -> Character a
fmap :: (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 a -> LinePrewritten b -> LinePrewritten a
(a -> b) -> LinePrewritten a -> LinePrewritten b
(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
<$ :: a -> LinePrewritten b -> LinePrewritten a
$c<$ :: forall a b. a -> LinePrewritten b -> LinePrewritten a
fmap :: (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 a -> Password b -> Password a
(a -> b) -> Password a -> Password b
(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
<$ :: a -> Password b -> Password a
$c<$ :: forall a b. a -> Password b -> Password a
fmap :: (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 :: (a -> b) -> ArbitraryIO a -> ArbitraryIO b
fmap f :: a -> b
f (ArbitraryIO iov :: IO a
iov f' :: 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 (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' :: 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 (m :: * -> *) a. Monad m => a -> m a
return f (b a) -> b a
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 :: Wizard f a -> b (Maybe a)
run (Wizard c :: 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)