{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use fmap" #-}
{-# HLINT ignore "Use const" #-}
{-# HLINT ignore "Avoid lambda" #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2023 Yamada Ryo
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable

A final-encoded generic Freer carrier.
-}
module Control.Freer.Final where

import Control.Applicative (Alternative, empty, liftA2, many, some, (<|>))
import Control.Effect (type (~>))
import Control.Freer (Freer, interpretFreer, liftIns)
import Control.Monad (MonadPlus, mplus, mzero)
import Control.Monad.Freer (MonadFreer)

-- | A final-encoded generic Freer carrier.
newtype FreerFinal c f a = FreerFinal {forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
FreerFinal c f a -> forall (m :: * -> *). c m => (f ~> m) -> m a
unFreerFinal :: forall m. c m => (f ~> m) -> m a}

deriving stock instance (forall f. c f => Functor f) => Functor (FreerFinal c e)

instance
    (forall f. c f => Applicative f, Functor (FreerFinal c e)) =>
    Applicative (FreerFinal c e)
    where
    pure :: forall a. a -> FreerFinal c e a
pure a
x = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

    FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m (a -> b)
f <*> :: forall a b.
FreerFinal c e (a -> b) -> FreerFinal c e a -> FreerFinal c e b
<*> FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
g =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (m :: * -> *). c m => (e ~> m) -> m (a -> b)
f e ~> m
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). c m => (e ~> m) -> m a
g e ~> m
i

    liftA2 :: forall a b c.
(a -> b -> c)
-> FreerFinal c e a -> FreerFinal c e b -> FreerFinal c e c
liftA2 a -> b -> c
f (FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
fa) (FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m b
fb) =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (forall (m :: * -> *). c m => (e ~> m) -> m a
fa e ~> m
i) (forall (m :: * -> *). c m => (e ~> m) -> m b
fb e ~> m
i)

    FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f *> :: forall a b.
FreerFinal c e a -> FreerFinal c e b -> FreerFinal c e b
*> FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m b
g =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> m
i forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). c m => (e ~> m) -> m b
g e ~> m
i

    FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f <* :: forall a b.
FreerFinal c e a -> FreerFinal c e b -> FreerFinal c e a
<* FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m b
g =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> m
i forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). c m => (e ~> m) -> m b
g e ~> m
i

    {-# INLINE pure #-}
    {-# INLINE (<*>) #-}
    {-# INLINE liftA2 #-}
    {-# INLINE (*>) #-}
    {-# INLINE (<*) #-}

instance
    (forall f. c f => Alternative f, Applicative (FreerFinal c e)) =>
    Alternative (FreerFinal c e)
    where
    empty :: forall a. FreerFinal c e a
empty = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

    FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f <|> :: forall a. FreerFinal c e a -> FreerFinal c e a -> FreerFinal c e a
<|> FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
g =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> m
i forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). c m => (e ~> m) -> m a
g e ~> m
i

    some :: forall a. FreerFinal c e a -> FreerFinal c e [a]
some (FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f) = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> m
i)
    many :: forall a. FreerFinal c e a -> FreerFinal c e [a]
many (FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f) = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \e ~> m
i -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> m
i)

    {-# INLINE empty #-}
    {-# INLINE (<|>) #-}
    {-# INLINE some #-}
    {-# INLINE many #-}

instance (forall m. c m => Monad m, Applicative (FreerFinal c f)) => Monad (FreerFinal c f) where
    FreerFinal forall (m :: * -> *). c m => (f ~> m) -> m a
f >>= :: forall a b.
FreerFinal c f a -> (a -> FreerFinal c f b) -> FreerFinal c f b
>>= a -> FreerFinal c f b
k =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \f ~> m
i ->
            forall (m :: * -> *). c m => (f ~> m) -> m a
f f ~> m
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (c :: (* -> *) -> Constraint) (f :: * -> *) (e :: * -> *) a.
c f =>
(e ~> f) -> FreerFinal c e a -> f a
interpretFreerFinal f ~> m
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FreerFinal c f b
k

    >> :: forall a b.
FreerFinal c f a -> FreerFinal c f b -> FreerFinal c f b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    return :: forall a. a -> FreerFinal c f a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    {-# INLINE (>>=) #-}
    {-# INLINE (>>) #-}
    {-# INLINE return #-}

instance
    (forall m. c m => MonadPlus m, Alternative (FreerFinal c f), Monad (FreerFinal c f)) =>
    MonadPlus (FreerFinal c f)
    where
    mzero :: forall a. FreerFinal c f a
mzero = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \f ~> m
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

    FreerFinal forall (m :: * -> *). c m => (f ~> m) -> m a
f mplus :: forall a. FreerFinal c f a -> FreerFinal c f a -> FreerFinal c f a
`mplus` FreerFinal forall (m :: * -> *). c m => (f ~> m) -> m a
g =
        forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \f ~> m
i -> forall (m :: * -> *). c m => (f ~> m) -> m a
f f ~> m
i forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *). c m => (f ~> m) -> m a
g f ~> m
i

    {-# INLINE mzero #-}
    {-# INLINE mplus #-}

interpretFreerFinal :: c f => (e ~> f) -> FreerFinal c e a -> f a
interpretFreerFinal :: forall (c :: (* -> *) -> Constraint) (f :: * -> *) (e :: * -> *) a.
c f =>
(e ~> f) -> FreerFinal c e a -> f a
interpretFreerFinal e ~> f
i (FreerFinal forall (m :: * -> *). c m => (e ~> m) -> m a
f) = forall (m :: * -> *). c m => (e ~> m) -> m a
f e ~> f
i
{-# INLINE interpretFreerFinal #-}

liftInsFinal :: ins a -> FreerFinal c ins a
liftInsFinal :: forall (ins :: * -> *) a (c :: (* -> *) -> Constraint).
ins a -> FreerFinal c ins a
liftInsFinal ins a
e = forall (c :: (* -> *) -> Constraint) (f :: * -> *) a.
(forall (m :: * -> *). c m => (f ~> m) -> m a) -> FreerFinal c f a
FreerFinal \ins ~> m
i -> ins ~> m
i ins a
e
{-# INLINE liftInsFinal #-}

instance (forall e. c (FreerFinal c e)) => Freer c (FreerFinal c) where
    liftIns :: forall (e :: * -> *) a. e a -> FreerFinal c e a
liftIns = forall (ins :: * -> *) a (c :: (* -> *) -> Constraint).
ins a -> FreerFinal c ins a
liftInsFinal
    interpretFreer :: forall (m :: * -> *) (e :: * -> *) a.
c m =>
(e ~> m) -> FreerFinal c e a -> m a
interpretFreer = forall (c :: (* -> *) -> Constraint) (f :: * -> *) (e :: * -> *) a.
c f =>
(e ~> f) -> FreerFinal c e a -> f a
interpretFreerFinal
    {-# INLINE liftIns #-}
    {-# INLINE interpretFreer #-}

instance MonadFreer Monad (FreerFinal Monad)