{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Eta reduce" #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2023-2025 Sayo contributors
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
-}
module Data.Effect.TH (
    module Data.Effect.TH,
    module Data.Default,
    module Data.Function,
    EffectOrder (..),
    EffectConf (..),
    OpConf (..),
    keyedPerformerConf,
    normalPerformerConf,
    taggedPerformerConf,
    PerformerConf (..),
    performerName,
    doesGeneratePerformerSignature,
    performerDoc,
    performerArgDoc,
    performerConfs,
    deriveHFunctor,
    noGenerateNormalPerformer,
    noGenerateTaggedPerformer,
    noGenerateKeyedPerformer,
    noGeneratePerformerSignature,
    noGenerateLabel,
    noGenerateOrderInstance,
    Infinite ((:<)),
) where

import Control.Monad.Reader (ask, runReaderT)
import Control.Monad.Writer.CPS (execWriterT, lift, tell)
import Data.Default (Default (def))
import Data.Effect (EffectOrder (FirstOrder, HigherOrder))
import Data.Effect.HFunctor.TH.Internal (deriveHFunctor)
import Data.Effect.TH.Internal (
    EffectConf (..),
    EffectGenerator,
    OpConf (..),
    PerformerConf (..),
    doesGeneratePerformerSignature,
    genFOE,
    genHOE,
    keyedPerformerConf,
    noGenerateKeyedPerformer,
    noGenerateLabel,
    noGenerateNormalPerformer,
    noGenerateOrderInstance,
    noGeneratePerformerSignature,
    noGenerateTaggedPerformer,
    normalPerformerConf,
    performerArgDoc,
    performerConfs,
    performerDoc,
    performerName,
    reifyEffect,
    taggedPerformerConf,
 )
import Data.Function ((&))
import Data.List.Infinite (Infinite ((:<)))
import Language.Haskell.TH (Dec, Name, Q, Type (TupleT))

makeEffectF :: Name -> Q [Dec]
makeEffectsF :: [Name] -> Q [Dec]
makeEffectF' :: EffectConf -> Name -> Q [Dec]
(Name -> Q [Dec]
makeEffectF, [Name] -> Q [Dec]
makeEffectsF, EffectConf -> Name -> Q [Dec]
makeEffectF') = EffectGenerator
-> (Name -> Q [Dec], [Name] -> Q [Dec],
    EffectConf -> Name -> Q [Dec])
effectMakers EffectGenerator
genFOEwithHFunctor

makeEffectF_ :: Name -> Q [Dec]
makeEffectsF_ :: [Name] -> Q [Dec]
makeEffectF_' :: EffectConf -> Name -> Q [Dec]
(Name -> Q [Dec]
makeEffectF_, [Name] -> Q [Dec]
makeEffectsF_, EffectConf -> Name -> Q [Dec]
makeEffectF_') = EffectGenerator
-> (Name -> Q [Dec], [Name] -> Q [Dec],
    EffectConf -> Name -> Q [Dec])
effectMakers EffectGenerator
genFOE

makeEffectH :: Name -> Q [Dec]
makeEffectsH :: [Name] -> Q [Dec]
makeEffectH' :: EffectConf -> Name -> Q [Dec]
(Name -> Q [Dec]
makeEffectH, [Name] -> Q [Dec]
makeEffectsH, EffectConf -> Name -> Q [Dec]
makeEffectH') = EffectGenerator
-> (Name -> Q [Dec], [Name] -> Q [Dec],
    EffectConf -> Name -> Q [Dec])
effectMakers EffectGenerator
genHOEwithHFunctor

makeEffectH_ :: Name -> Q [Dec]
makeEffectsH_ :: [Name] -> Q [Dec]
makeEffectH_' :: EffectConf -> Name -> Q [Dec]
(Name -> Q [Dec]
makeEffectH_, [Name] -> Q [Dec]
makeEffectsH_, EffectConf -> Name -> Q [Dec]
makeEffectH_') = EffectGenerator
-> (Name -> Q [Dec], [Name] -> Q [Dec],
    EffectConf -> Name -> Q [Dec])
effectMakers EffectGenerator
genHOE

effectMakers
    :: EffectGenerator
    -> ( Name -> Q [Dec]
       , [Name] -> Q [Dec]
       , EffectConf -> Name -> Q [Dec]
       )
effectMakers :: EffectGenerator
-> (Name -> Q [Dec], [Name] -> Q [Dec],
    EffectConf -> Name -> Q [Dec])
effectMakers EffectGenerator
gen =
    ( WriterT [Dec] Q () -> Q [Dec]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
WriterT w m a -> m w
execWriterT (WriterT [Dec] Q () -> Q [Dec])
-> (Name -> WriterT [Dec] Q ()) -> Name -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectConf -> Name -> WriterT [Dec] Q ()
gen' EffectConf
forall a. Default a => a
def
    , WriterT [Dec] Q [()] -> Q [Dec]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
WriterT w m a -> m w
execWriterT (WriterT [Dec] Q [()] -> Q [Dec])
-> ([Name] -> WriterT [Dec] Q [()]) -> [Name] -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> WriterT [Dec] Q ()) -> [Name] -> WriterT [Dec] Q [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (EffectConf -> Name -> WriterT [Dec] Q ()
gen' EffectConf
forall a. Default a => a
def)
    , \EffectConf
conf -> WriterT [Dec] Q () -> Q [Dec]
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
WriterT w m a -> m w
execWriterT (WriterT [Dec] Q () -> Q [Dec])
-> (Name -> WriterT [Dec] Q ()) -> Name -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectConf -> Name -> WriterT [Dec] Q ()
gen' EffectConf
conf
    )
  where
    gen' :: EffectConf -> Name -> WriterT [Dec] Q ()
gen' EffectConf
conf Name
e = do
        (Info
info, DataInfo
dataInfo, EffectInfo
eInfo) <- Name -> Q (Info, DataInfo, EffectInfo)
reifyEffect Name
e Q (Info, DataInfo, EffectInfo)
-> (Q (Info, DataInfo, EffectInfo)
    -> WriterT [Dec] Q (Info, DataInfo, EffectInfo))
-> WriterT [Dec] Q (Info, DataInfo, EffectInfo)
forall a b. a -> (a -> b) -> b
& Q (Info, DataInfo, EffectInfo)
-> WriterT [Dec] Q (Info, DataInfo, EffectInfo)
forall (m :: * -> *) a. Monad m => m a -> WriterT [Dec] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        EffectGenerator
-> (EffectConf, Name, Info, DataInfo, EffectInfo)
-> WriterT [Dec] Q ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EffectGenerator
gen (EffectConf
conf, Name
e, Info
info, DataInfo
dataInfo, EffectInfo
eInfo)

genFOEwithHFunctor :: EffectGenerator
genFOEwithHFunctor :: EffectGenerator
genFOEwithHFunctor = do
    EffectGenerator
genFOE
    (EffectConf
_, Name
_, Info
_, DataInfo
dataInfo, EffectInfo
_) <- ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo)
  (WriterT [Dec] Q)
  (EffectConf, Name, Info, DataInfo, EffectInfo)
forall r (m :: * -> *). MonadReader r m => m r
ask
    (Infinite (Q Type) -> Q Type) -> DataInfo -> Q [Dec]
deriveHFunctor (Q Type -> Infinite (Q Type) -> Q Type
forall a b. a -> b -> a
const (Q Type -> Infinite (Q Type) -> Q Type)
-> Q Type -> Infinite (Q Type) -> Q Type
forall a b. (a -> b) -> a -> b
$ Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Int -> Type
TupleT Int
0) DataInfo
dataInfo Q [Dec]
-> (Q [Dec] -> WriterT [Dec] Q [Dec]) -> WriterT [Dec] Q [Dec]
forall a b. a -> (a -> b) -> b
& Q [Dec] -> WriterT [Dec] Q [Dec]
forall (m :: * -> *) a. Monad m => m a -> WriterT [Dec] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift WriterT [Dec] Q [Dec]
-> (WriterT [Dec] Q [Dec]
    -> ReaderT
         (EffectConf, Name, Info, DataInfo, EffectInfo)
         (WriterT [Dec] Q)
         [Dec])
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo)
     (WriterT [Dec] Q)
     [Dec]
forall a b. a -> (a -> b) -> b
& WriterT [Dec] Q [Dec]
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo)
     (WriterT [Dec] Q)
     [Dec]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (EffectConf, Name, Info, DataInfo, EffectInfo) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo)
  (WriterT [Dec] Q)
  [Dec]
-> ([Dec] -> EffectGenerator) -> EffectGenerator
forall a b.
ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) a
-> (a
    -> ReaderT
         (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) b)
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> EffectGenerator
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

genHOEwithHFunctor :: EffectGenerator
genHOEwithHFunctor :: EffectGenerator
genHOEwithHFunctor = do
    EffectGenerator
genHOE
    (EffectConf
_, Name
_, Info
_, DataInfo
dataInfo, EffectInfo
_) <- ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo)
  (WriterT [Dec] Q)
  (EffectConf, Name, Info, DataInfo, EffectInfo)
forall r (m :: * -> *). MonadReader r m => m r
ask
    (Infinite (Q Type) -> Q Type) -> DataInfo -> Q [Dec]
deriveHFunctor (Q Type -> Infinite (Q Type) -> Q Type
forall a b. a -> b -> a
const (Q Type -> Infinite (Q Type) -> Q Type)
-> Q Type -> Infinite (Q Type) -> Q Type
forall a b. (a -> b) -> a -> b
$ Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Int -> Type
TupleT Int
0) DataInfo
dataInfo Q [Dec]
-> (Q [Dec] -> WriterT [Dec] Q [Dec]) -> WriterT [Dec] Q [Dec]
forall a b. a -> (a -> b) -> b
& Q [Dec] -> WriterT [Dec] Q [Dec]
forall (m :: * -> *) a. Monad m => m a -> WriterT [Dec] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift WriterT [Dec] Q [Dec]
-> (WriterT [Dec] Q [Dec]
    -> ReaderT
         (EffectConf, Name, Info, DataInfo, EffectInfo)
         (WriterT [Dec] Q)
         [Dec])
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo)
     (WriterT [Dec] Q)
     [Dec]
forall a b. a -> (a -> b) -> b
& WriterT [Dec] Q [Dec]
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo)
     (WriterT [Dec] Q)
     [Dec]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (EffectConf, Name, Info, DataInfo, EffectInfo) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo)
  (WriterT [Dec] Q)
  [Dec]
-> ([Dec] -> EffectGenerator) -> EffectGenerator
forall a b.
ReaderT
  (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) a
-> (a
    -> ReaderT
         (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) b)
-> ReaderT
     (EffectConf, Name, Info, DataInfo, EffectInfo) (WriterT [Dec] Q) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> EffectGenerator
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell