-- |
-- Module: M.Pack.Internal.TH
-- Description: Template Haskell serialization utilities
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Provides Template Haskell machinery for automatically deriving Pack and
-- Unpack instances, including support for shadowing and proper derivation.
module M.Pack.Internal.TH
  ( borrowderivepackunpack,
    properderivepackunpack,
    borrowderivenothing,
  )
where

import Data.Functor
import Data.Serde.QQ
import Language.Haskell.TH
import M.Pack.Internal.Types

-- | shadow-derive 'Pack' and 'Unpack' instances for a type
borrowderivepackunpack :: RunUserCoercion -> Q [Dec]
borrowderivepackunpack :: RunUserCoercion -> Q [Dec]
borrowderivepackunpack RunUserCoercion {Q Exp
Q Pat
Q Type
patnormal :: Q Pat
patshadow :: Q Pat
appnormal :: Q Exp
appshadow :: Q Exp
datatyp :: Q Type
shadowdatatyp :: Q Type
appnormal :: RunUserCoercion -> Q Exp
appshadow :: RunUserCoercion -> Q Exp
datatyp :: RunUserCoercion -> Q Type
patnormal :: RunUserCoercion -> Q Pat
patshadow :: RunUserCoercion -> Q Pat
shadowdatatyp :: RunUserCoercion -> Q Type
..} = do
  [d|
    instance Pack $Q Type
datatyp where
      pack $Q Pat
patnormal = pack $Q Exp
appshadow
      {-# INLINEABLE pack #-}

    instance Unpack $Q Type
datatyp where
      unpack = unpack <&> \($Q Pat
patshadow) -> $Q Exp
appnormal
      {-# INLINEABLE unpack #-}
    |]

properderivepackunpack :: Name -> Q [Dec]
properderivepackunpack :: Name -> Q [Dec]
properderivepackunpack Name
n = do
  [d|
    instance Pack $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
n)

    instance Unpack $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
n)
    |]

-- | literally do nothing
borrowderivenothing :: RunUserCoercion -> Q [Dec]
borrowderivenothing :: RunUserCoercion -> Q [Dec]
borrowderivenothing RunUserCoercion
_ = [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []