module Data.OpenApi.Compare.Report.Jet
( ReportJet (..),
ReportJet',
ConstructReportJet (..),
ReportJetResult,
)
where
import Control.Applicative
import Control.Monad.Free
import Data.List.NonEmpty
import qualified Data.List.NonEmpty as NE
import Data.OpenUnion
import Data.OpenUnion.Extra
import Data.Typeable
import Text.Pandoc.Builder
class ConstructReportJet x f where
constructReportJet :: x -> ReportJetResult f (Maybe Inlines)
instance (ConstructReportJet b f, JetArg a) => ConstructReportJet (a -> b) f where
constructReportJet :: (a -> b) -> ReportJetResult f (Maybe Inlines)
constructReportJet a -> b
f = ReportJet f (Free (ReportJet f) b) -> Free (ReportJet f) b
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((a -> b) -> Free (ReportJet f) a -> Free (ReportJet f) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Free (ReportJet f) a -> Free (ReportJet f) b)
-> ReportJet f (Free (ReportJet f) a)
-> ReportJet f (Free (ReportJet f) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k k (f :: k -> k -> *). JetArg a => ReportJet' f a
forall a k k (f :: k -> k -> *). JetArg a => ReportJet' f a
consumeJetArg @a) Free (ReportJet f) b
-> (b -> ReportJetResult f (Maybe Inlines))
-> ReportJetResult f (Maybe Inlines)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ReportJetResult f (Maybe Inlines)
forall k k x (f :: k -> k -> *).
ConstructReportJet x f =>
x -> ReportJetResult f (Maybe Inlines)
constructReportJet
instance ConstructReportJet (Maybe Inlines) f where
constructReportJet :: Maybe Inlines -> ReportJetResult f (Maybe Inlines)
constructReportJet Maybe Inlines
x = Maybe Inlines -> ReportJetResult f (Maybe Inlines)
forall (f :: * -> *) a. a -> Free f a
Pure Maybe Inlines
x
instance ConstructReportJet Inlines f where
constructReportJet :: Inlines -> ReportJetResult f (Maybe Inlines)
constructReportJet Inlines
x = Maybe Inlines -> ReportJetResult f (Maybe Inlines)
forall (f :: * -> *) a. a -> Free f a
Pure (Maybe Inlines -> ReportJetResult f (Maybe Inlines))
-> Maybe Inlines -> ReportJetResult f (Maybe Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x
class JetArg a where
consumeJetArg :: ReportJet' f a
instance Typeable (f a b) => JetArg (f a b) where
consumeJetArg :: ReportJet' f (f a b)
consumeJetArg =
(forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (f a b)))
-> ReportJet' f (f a b)
forall k k (f :: k -> k -> *) x.
(forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m x)
-> ReportJet f x
ReportJet ((forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (f a b)))
-> ReportJet' f (f a b))
-> (forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (f a b)))
-> ReportJet' f (f a b)
forall a b. (a -> b) -> a -> b
$ \(f a b
x :: x) ->
case (Typeable (f a b), Typeable (f a b)) => Maybe (f a b :~: f a b)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @(f a b) @x of
Maybe (f a b :~: f a b)
Nothing -> m (Free (ReportJet f) (f a b))
forall (f :: * -> *) a. Alternative f => f a
empty
Just f a b :~: f a b
Refl -> Free (ReportJet f) (f a b) -> m (Free (ReportJet f) (f a b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Free (ReportJet f) (f a b) -> m (Free (ReportJet f) (f a b)))
-> Free (ReportJet f) (f a b) -> m (Free (ReportJet f) (f a b))
forall a b. (a -> b) -> a -> b
$ f a b -> Free (ReportJet f) (f a b)
forall (f :: * -> *) a. a -> Free f a
Pure f a b
x
instance TryLiftUnion xs => JetArg (Union xs) where
consumeJetArg :: ReportJet' f (Union xs)
consumeJetArg = (forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (Union xs)))
-> ReportJet' f (Union xs)
forall k k (f :: k -> k -> *) x.
(forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m x)
-> ReportJet f x
ReportJet ((forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (Union xs)))
-> ReportJet' f (Union xs))
-> (forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (Union xs)))
-> ReportJet' f (Union xs)
forall a b. (a -> b) -> a -> b
$ (Union xs -> Free (ReportJet f) (Union xs))
-> m (Union xs) -> m (Free (ReportJet f) (Union xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Union xs -> Free (ReportJet f) (Union xs)
forall (f :: * -> *) a. a -> Free f a
Pure (m (Union xs) -> m (Free (ReportJet f) (Union xs)))
-> (f a b -> m (Union xs))
-> f a b
-> m (Free (ReportJet f) (Union xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a b -> m (Union xs)
forall (xs :: [*]) (m :: * -> *) x.
(TryLiftUnion xs, Alternative m, Typeable x) =>
x -> m (Union xs)
tryLiftUnion
instance JetArg x => JetArg (NonEmpty x) where
consumeJetArg :: ReportJet' f (NonEmpty x)
consumeJetArg =
let (ReportJet forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) x)
f) = (forall k k (f :: k -> k -> *). JetArg x => ReportJet' f x
forall a k k (f :: k -> k -> *). JetArg a => ReportJet' f a
consumeJetArg @x)
in (forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (NonEmpty x)))
-> ReportJet' f (NonEmpty x)
forall k k (f :: k -> k -> *) x.
(forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m x)
-> ReportJet f x
ReportJet ((forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (NonEmpty x)))
-> ReportJet' f (NonEmpty x))
-> (forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) (NonEmpty x)))
-> ReportJet' f (NonEmpty x)
forall a b. (a -> b) -> a -> b
$ \f a b
a -> do
Free (ReportJet f) x
u <- f a b -> m (Free (ReportJet f) x)
forall (a :: k) (b :: k) (m :: * -> *).
(Typeable (f a b), Alternative m, Monad m) =>
f a b -> m (Free (ReportJet f) x)
f f a b
a
Free (ReportJet f) (NonEmpty x)
-> m (Free (ReportJet f) (NonEmpty x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Free (ReportJet f) x
u Free (ReportJet f) x
-> (x -> Free (ReportJet f) (NonEmpty x))
-> Free (ReportJet f) (NonEmpty x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
y -> ReportJet' f (NonEmpty x) -> Free (ReportJet f) (NonEmpty x)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (ReportJet' f (NonEmpty x) -> Free (ReportJet f) (NonEmpty x))
-> ReportJet' f (NonEmpty x) -> Free (ReportJet f) (NonEmpty x)
forall a b. (a -> b) -> a -> b
$ (NonEmpty x -> NonEmpty x)
-> Free (ReportJet f) (NonEmpty x)
-> Free (ReportJet f) (NonEmpty x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> NonEmpty x -> NonEmpty x
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons x
y) (Free (ReportJet f) (NonEmpty x)
-> Free (ReportJet f) (NonEmpty x))
-> ReportJet' f (NonEmpty x) -> ReportJet' f (NonEmpty x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportJet' f (NonEmpty x)
forall a k k (f :: k -> k -> *). JetArg a => ReportJet' f a
consumeJetArg)
m (Free (ReportJet f) (NonEmpty x))
-> m (Free (ReportJet f) (NonEmpty x))
-> m (Free (ReportJet f) (NonEmpty x))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Free (ReportJet f) (NonEmpty x)
-> m (Free (ReportJet f) (NonEmpty x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> NonEmpty x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> NonEmpty x)
-> Free (ReportJet f) x -> Free (ReportJet f) (NonEmpty x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free (ReportJet f) x
u)
type ReportJetResult f = Free (ReportJet f)
newtype ReportJet f x
= ReportJet (forall a b m. (Typeable (f a b), Alternative m, Monad m) => f a b -> m x)
deriving stock (a -> ReportJet f b -> ReportJet f a
(a -> b) -> ReportJet f a -> ReportJet f b
(forall a b. (a -> b) -> ReportJet f a -> ReportJet f b)
-> (forall a b. a -> ReportJet f b -> ReportJet f a)
-> Functor (ReportJet f)
forall a b. a -> ReportJet f b -> ReportJet f a
forall a b. (a -> b) -> ReportJet f a -> ReportJet f b
forall k k (f :: k -> k -> *) a b.
a -> ReportJet f b -> ReportJet f a
forall k k (f :: k -> k -> *) a b.
(a -> b) -> ReportJet f a -> ReportJet f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReportJet f b -> ReportJet f a
$c<$ :: forall k k (f :: k -> k -> *) a b.
a -> ReportJet f b -> ReportJet f a
fmap :: (a -> b) -> ReportJet f a -> ReportJet f b
$cfmap :: forall k k (f :: k -> k -> *) a b.
(a -> b) -> ReportJet f a -> ReportJet f b
Functor)
type ReportJet' f a = ReportJet f (Free (ReportJet f) a)