module Database.HDBC.SqlValue.List where
import Database.HDBC.SqlValue
import Data.Convertible
class SqlValueList a where
toSqlList :: a -> [SqlValue]
fromSqlList :: [SqlValue] -> a
instance (Convertible SqlValue a, Convertible a SqlValue) => SqlValueList [a]
where toSqlList = map toSql
fromSqlList = map fromSql
instance ( Convertible SqlValue t1, Convertible t1 SqlValue
, Convertible SqlValue t2, Convertible t2 SqlValue)
=> SqlValueList (t1, t2)
where toSqlList (x1, x2) = [toSql x1, toSql x2]
fromSqlList [x1, x2] = (fromSql x1, fromSql x2)
instance ( Convertible SqlValue t1, Convertible t1 SqlValue
, Convertible SqlValue t2, Convertible t2 SqlValue
, Convertible SqlValue t3, Convertible t3 SqlValue)
=> SqlValueList (t1, t2, t3)
where toSqlList (x1, x2, x3) = [toSql x1, toSql x2, toSql x3]
fromSqlList [x1, x2, x3] = (fromSql x1, fromSql x2, fromSql x3)
instance ( Convertible SqlValue t1, Convertible t1 SqlValue
, Convertible SqlValue t2, Convertible t2 SqlValue
, Convertible SqlValue t3, Convertible t3 SqlValue
, Convertible SqlValue t4, Convertible t4 SqlValue)
=> SqlValueList (t1, t2, t3, t4)
where toSqlList (x1, x2, x3, x4) = [toSql x1, toSql x2, toSql x3, toSql x4]
fromSqlList [x1, x2, x3, x4] = (fromSql x1, fromSql x2
,fromSql x3, fromSql x4)
instance ( Convertible SqlValue t1, Convertible t1 SqlValue
, Convertible SqlValue t2, Convertible t2 SqlValue
, Convertible SqlValue t3, Convertible t3 SqlValue
, Convertible SqlValue t4, Convertible t4 SqlValue
, Convertible SqlValue t5, Convertible t5 SqlValue)
=> SqlValueList (t1, t2, t3, t4, t5)
where toSqlList (x1, x2, x3, x4, x5) = [toSql x1, toSql x2, toSql x3
, toSql x4, toSql x5]
fromSqlList [x1, x2, x3, x4, x5] = (fromSql x1, fromSql x2, fromSql x3
,fromSql x4, fromSql x5)