{-# 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 :: Int -> Q Dec
genDecodeRowInstance Int
tupSize
  | Int
tupSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = String -> Q Dec
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"this is just for tuples, must specify a tuple size of 2 or greater"
  | Bool
otherwise = do
    tyVars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tupSize (String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x")
    context <- traverse (\Name
x -> [t|$(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (String -> Name
mkName String
"DecodeField")) $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
x)|]) tyVars
    instanceHead <- [t|$(conT (mkName "DecodeRow")) $(pure $ foldl' AppT (TupleT tupSize) (map VarT tyVars))|]
    let tupSection = [Maybe Exp] -> Exp
TupE (Int -> Maybe Exp -> [Maybe Exp]
forall a. Int -> a -> [a]
replicate Int
tupSize Maybe Exp
forall a. Maybe a
Nothing)
        go m Exp
b p
_a = do
          [e|$(m Exp
b) <*> column decodeField|]

    instanceBodyExp <- foldl' go [e|$(pure tupSection) <$> column decodeField|] (drop 1 tyVars)
    let instanceBody = Name -> [Clause] -> Dec
FunD (String -> Name
mkName String
"decodeRow") [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
instanceBodyExp) []]
    pure (InstanceD Nothing context instanceHead [instanceBody])