{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Free.MailCommand
  ( sendMail,
    MailCommand (..),
  )
where

import WikiMusic.Model.Env
import WikiMusic.Model.Mail
import WikiMusic.Protolude

data MailCommand a
  = SendMail Env MailSendRequest (Either MailCommandError MailCommandOutcome -> a)
  deriving ((forall a b. (a -> b) -> MailCommand a -> MailCommand b)
-> (forall a b. a -> MailCommand b -> MailCommand a)
-> Functor MailCommand
forall a b. a -> MailCommand b -> MailCommand a
forall a b. (a -> b) -> MailCommand a -> MailCommand 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) -> MailCommand a -> MailCommand b
fmap :: forall a b. (a -> b) -> MailCommand a -> MailCommand b
$c<$ :: forall a b. a -> MailCommand b -> MailCommand a
<$ :: forall a b. a -> MailCommand b -> MailCommand a
Functor)

sendMail :: (MailCommand :<: f) => Env -> MailSendRequest -> Free f (Either MailCommandError MailCommandOutcome)
sendMail :: forall (f :: * -> *).
(MailCommand :<: f) =>
Env
-> MailSendRequest
-> Free f (Either MailCommandError MailCommandOutcome)
sendMail Env
env MailSendRequest
req = MailCommand (Free f (Either MailCommandError MailCommandOutcome))
-> Free f (Either MailCommandError MailCommandOutcome)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> MailSendRequest
-> (Either MailCommandError MailCommandOutcome
    -> Free f (Either MailCommandError MailCommandOutcome))
-> MailCommand
     (Free f (Either MailCommandError MailCommandOutcome))
forall a.
Env
-> MailSendRequest
-> (Either MailCommandError MailCommandOutcome -> a)
-> MailCommand a
SendMail Env
env MailSendRequest
req Either MailCommandError MailCommandOutcome
-> Free f (Either MailCommandError MailCommandOutcome)
forall (f :: * -> *) a. a -> Free f a
Pure)