{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

{- |
Module      : Database.DuckDB.Simple.ToRow
Description : Rendering Haskell collections into parameter rows.

The 'ToRow' class converts Haskell values into lists of 'FieldBinding's that
can be consumed by statement binding functions.
-}
module Database.DuckDB.Simple.ToRow (
    ToRow (..),
    GToRow (..),
) where

import Database.DuckDB.Simple.ToField (FieldBinding, ToField (..))
import Database.DuckDB.Simple.Types (Only (..), (:.) (..))
import GHC.Generics

-- | Types that can be transformed into parameter bindings.
class ToRow a where
    toRow :: a -> [FieldBinding]
    default toRow :: (Generic a, GToRow (Rep a)) => a -> [FieldBinding]
    toRow = Rep a Any -> [FieldBinding]
forall p. Rep a p -> [FieldBinding]
forall (f :: * -> *) p. GToRow f => f p -> [FieldBinding]
gtoRow (Rep a Any -> [FieldBinding])
-> (a -> Rep a Any) -> a -> [FieldBinding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

-- | Generic helper for deriving 'ToRow'.
class GToRow f where
    gtoRow :: f p -> [FieldBinding]

instance GToRow U1 where
    gtoRow :: forall p. U1 p -> [FieldBinding]
gtoRow U1 p
_ = []

instance (ToField a) => GToRow (K1 i a) where
    gtoRow :: forall p. K1 i a p -> [FieldBinding]
gtoRow (K1 a
a) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a]

instance (GToRow a, GToRow b) => GToRow (a :*: b) where
    gtoRow :: forall p. (:*:) a b p -> [FieldBinding]
gtoRow (a p
a :*: b p
b) = a p -> [FieldBinding]
forall p. a p -> [FieldBinding]
forall (f :: * -> *) p. GToRow f => f p -> [FieldBinding]
gtoRow a p
a [FieldBinding] -> [FieldBinding] -> [FieldBinding]
forall a. [a] -> [a] -> [a]
++ b p -> [FieldBinding]
forall p. b p -> [FieldBinding]
forall (f :: * -> *) p. GToRow f => f p -> [FieldBinding]
gtoRow b p
b

instance (GToRow a) => GToRow (M1 i c a) where
    gtoRow :: forall p. M1 i c a p -> [FieldBinding]
gtoRow (M1 a p
a) = a p -> [FieldBinding]
forall p. a p -> [FieldBinding]
forall (f :: * -> *) p. GToRow f => f p -> [FieldBinding]
gtoRow a p
a

instance ToRow () where
    toRow :: () -> [FieldBinding]
toRow () = []

instance (ToField a) => ToRow (Only a) where
    toRow :: Only a -> [FieldBinding]
toRow (Only a
a) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a]

instance (ToField a, ToField b) => ToRow (a, b) where
    toRow :: (a, b) -> [FieldBinding]
toRow (a
a, b
b) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a, b -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField b
b]

instance (ToField a, ToField b, ToField c) => ToRow (a, b, c) where
    toRow :: (a, b, c) -> [FieldBinding]
toRow (a
a, b
b, c
c) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a, b -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField b
b, c -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField c
c]

instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a, b, c, d) where
    toRow :: (a, b, c, d) -> [FieldBinding]
toRow (a
a, b
b, c
c, d
d) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a, b -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField b
b, c -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField c
c, d -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField d
d]

instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToRow (a, b, c, d, e) where
    toRow :: (a, b, c, d, e) -> [FieldBinding]
toRow (a
a, b
b, c
c, d
d, e
e) = [a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField a
a, b -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField b
b, c -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField c
c, d -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField d
d, e -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField e
e]

instance (ToField a) => ToRow [a] where
    toRow :: [a] -> [FieldBinding]
toRow = (a -> FieldBinding) -> [a] -> [FieldBinding]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FieldBinding
forall a. ToField a => a -> FieldBinding
toField

instance (ToRow a, ToRow b) => ToRow (a :. b) where
    toRow :: (a :. b) -> [FieldBinding]
toRow (a
a :. b
b) = a -> [FieldBinding]
forall a. ToRow a => a -> [FieldBinding]
toRow a
a [FieldBinding] -> [FieldBinding] -> [FieldBinding]
forall a. [a] -> [a] -> [a]
++ b -> [FieldBinding]
forall a. ToRow a => a -> [FieldBinding]
toRow b
b