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

{-# OPTIONS_HADDOCK not-home #-}

module Morley.Michelson.Typed.Scope.Internal.TH
  (module Morley.Michelson.Typed.Scope.Internal.TH
  ) where

import Debug qualified

import Language.Haskell.TH qualified as TH
import Morley.Michelson.Typed.Scope.Internal.ForbidT

byTPredicateSymCases :: TH.ExpQ -> [(TH.Name, TH.ExpQ)] -> TH.ExpQ -> TH.ExpQ
byTPredicateSymCases sp specific rest = do
  TH.TyConI (TH.DataD _ _ _ _ cons' _) <- TH.reify ''SingTPredicateSym
  let cons = cons' <&> \case
        TH.NormalC nm _ -> nm
        TH.GadtC [nm] _ _ -> nm
        c -> error $ "unexpected constructor " <> Debug.show c
      specCons = map fst specific
      restCons = filter (`notElem` specCons) cons
      cases = specific <> (restCons <&> (, rest))
      matches = first (flip TH.conP []) <$> cases
  TH.caseE sp [ TH.match pat (TH.normalB expr) [] | (pat, expr) <- matches ]