-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# LANGUAGE QuasiQuotes #-}

-- | Template haskell generator for 'RecFromTuple', in a separate module
-- because of staging restrictions.
module Morley.Util.TypeTuple.TH
  ( deriveRecFromTuple
  ) where

import Data.Vinyl.Core (Rec(..))
import Language.Haskell.TH qualified as TH

import Morley.Util.TH (tupT)
import Morley.Util.TypeTuple.Class

-- | Produce 'RecFromTuple' instance for tuple of the given length.
deriveRecFromTuple :: Word16 -> TH.Q [TH.Dec]
deriveRecFromTuple (fromIntegral -> n) = do
  -- The `f` type variable
  fVar <- TH.varT <$> TH.newName "f"
  -- The argument type variables
  tyVars <- replicateM n $ TH.varT <$> TH.newName "x"

  -- A type level list of the argument type variables
  let tyList = foldr (\ty lty -> [t| $ty ': $lty |]) [t| '[] |] tyVars

  -- A tuple type of `f` applied to the argument type variables
  let tyTuple = tupT . map (\ty -> [t| $fVar $ty |]) $ tyVars

  -- Term variable names for the fields
  vars <- replicateM n $ TH.newName "a"
  -- Pattern and expression variables for the fields
  let varPats = map TH.varP vars
  let varExps = map TH.varE vars

  -- Terms and patterns for the records
  let recRes = foldr (\var acc -> [e| $var :& $acc |]) [e|RNil|] varExps
  let recPat = foldr (\var acc -> [p| $var :& $acc |]) [p|RNil|] varPats

  [d| instance RecFromTuple (Rec ($fVar :: u -> Type) $tyList) where
        type IsoRecTuple (Rec $fVar $tyList) = $tyTuple
        recFromTuple $(TH.tupP varPats) = $recRes
        tupleFromRec $recPat = $(TH.tupE varExps)
    |]