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

-- | A "jet" is a way of simplifying expressions from "outside". The "jetted"
-- expressions should still be completely valid and correct without the jets.
-- Jets just make the expression more "optimized" by identifying patterns and
-- replacing the expressions with "better" ones that have the same sematics.
--
-- The term "jet" in this context was introduced in the Urbit project:
--   https://urbit.org/docs/vere/jetting/
--
-- The pattern fits well for simplifying 'Behavior' tree paths.
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)

-- Not a true 'Applicative'
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)