TH.hs

{-# LANGUAGE TemplateHaskell #-}

module Hasql.Interpolate.Internal.Decoder.TH
  ( genDecodeRowInstance,
  )
where

import Control.Monad
import Data.Foldable (foldl')
import Hasql.Decoders
import Language.Haskell.TH

-- | Generate a single 'Hasql.Interpolate.DecodeRow' instance for a
-- tuple of size @tupSize@
genDecodeRowInstance ::
  -- | tuple size
  Int ->
  Q Dec
genDecodeRowInstance tupSize
  | tupSize < 2 = fail "this is just for tuples, must specify a tuple size of 2 or greater"
  | otherwise = do
    tyVars <- replicateM tupSize (newName "x")
    context <- traverse (\x -> [t|$(conT (mkName "DecodeField")) $(varT x)|]) tyVars
    instanceHead <- [t|$(conT (mkName "DecodeRow")) $(pure $ foldl' AppT (TupleT tupSize) (map VarT tyVars))|]
    let tupSection = TupE (replicate tupSize Nothing)
        go b _a = do
          [e|$(b) <*> column decodeField|]

    instanceBodyExp <- foldl' go [e|$(pure tupSection) <$> column decodeField|] (tail tyVars)
    let instanceBody = FunD (mkName "decodeRow") [Clause [] (NormalB instanceBodyExp) []]
    pure (InstanceD Nothing context instanceHead [instanceBody])