{-# LANGUAGE NoImplicitPrelude
           , TemplateHaskell
           , QuasiQuotes
           , RecordWildCards
  #-}

module Jobs.TH
  ( dispatchTH
  ) where

import ClassyPrelude

import Language.Haskell.TH
import Language.Haskell.TH.Datatype

import Data.List (foldl)


dispatchTH :: Name -- ^ Datatype to pattern match
           -> ExpQ
dispatchTH dType = do
  DatatypeInfo{..} <- reifyDatatype dType
  let
    matches = map mkMatch datatypeCons
    mkMatch ConstructorInfo{..} = do
      pats <- forM constructorFields $ \_ -> newName "x"
      let fName = mkName $ "dispatch" <> nameBase constructorName
      match (conP constructorName $ map varP pats) (normalB $ foldl (\e pat -> e `appE` varE pat) (varE fName) pats) []
  lamCaseE matches