{-# 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,
) 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 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