{- |
Copyright  :  (C) 2025-2026, QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

A TH function for deriving 'Clash.Shockwaves.Waveform' for tuples.
-}
module Clash.Shockwaves.Internal.TH.Waveform where

import Control.Monad (replicateM)
import Language.Haskell.TH
import Prelude

{- | Derive 'Clash.Shockwaves.Waveform' implementations for tuples in the
specified range.
-}
deriveWaveformTuples :: Int -> Int -> DecsQ
deriveWaveformTuples :: Int -> Int -> DecsQ
deriveWaveformTuples Int
minSize Int
maxSize = do
  let waveform :: Type
waveform = Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Waveform"

  allNames <- Int -> Q Name -> Q [Name]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
maxSize (String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"a")

  return $ flip map [minSize .. maxSize] $ \Int
tupleNum ->
    let names :: [Name]
names = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
tupleNum [Name]
allNames
        vs :: [Type]
vs = (Name -> Type) -> [Name] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
names
        tuple :: Type
tuple = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
TupleT Int
tupleNum) [Type]
vs

        context :: [Type]
context = (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type
waveform Type -> Type -> Type
`AppT`) [Type]
vs
        instTy :: Type
instTy = Type -> Type -> Type
AppT Type
waveform Type
tuple

        translatorE :: Exp
translatorE = Exp -> Type -> Exp
AppTypeE (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"tupleTranslator") Type
tuple

        translator :: Dec
translator =
          Name -> [Clause] -> Dec
FunD
            (String -> Name
mkName String
"translator")
            [ [Pat] -> Body -> [Dec] -> Clause
Clause
                []
                (Exp -> Body
NormalB Exp
translatorE)
                []
            ]
     in Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [Type]
context Type
instTy [Dec
translator]