{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} module Database.PostgreSQL.Opium.ToParamList ( ToParamList (..) ) where import Data.ByteString (ByteString) import Data.Functor.Identity (Identity) import Database.PostgreSQL.LibPQ (Format, Oid) import GHC.Generics (Generic, K1 (..), M1 (..), Rec0, Rep, U1 (..), from, (:*:) (..)) import Database.PostgreSQL.Opium.ToField (ToField (..)) class ToParamList a where toParamList :: a -> [Maybe (Oid, ByteString, Format)] default toParamList :: (Generic a, ToParamList' (Rep a)) => a -> [Maybe (Oid, ByteString, Format)] toParamList = toParamList' . from instance ToField a => ToParamList [a] where toParamList = map toField instance ToParamList () where instance ToField a => ToParamList (Identity a) where instance (ToField a, ToField b) => ToParamList (a, b) where instance (ToField a, ToField b, ToField c) => ToParamList (a, b, c) where instance (ToField a, ToField b, ToField c, ToField d) => ToParamList (a, b, c, d) where instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToParamList (a, b, c, d, e) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToParamList (a, b, c, d, e, f) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToParamList (a, b, c, d, e, f, g) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h) => ToParamList (a, b, c, d, e, f, g, h) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i) => ToParamList (a, b, c, d, e, f, g, h, i) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j) => ToParamList (a, b, c, d, e, f, g, h, i, j) where instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j, ToField k) => ToParamList (a, b, c, d, e, f, g, h, i, j, k) where class ToParamList' f where toParamList' :: f p -> [Maybe (Oid, ByteString, Format)] instance ToField t => ToParamList' (Rec0 t) where toParamList' (K1 x) = [toField x] instance ToParamList' f => ToParamList' (M1 t c f) where toParamList' (M1 x) = toParamList' x instance ToParamList' U1 where toParamList' U1 = [] instance (ToParamList' f, ToParamList' g) => ToParamList' (f :*: g) where toParamList' (x :*: y) = toParamList' x ++ toParamList' y