@@ -1,14 +1,19 @@
1−{-# LANGUAGE DeriveGeneric, DefaultSignatures, FlexibleInstances, FlexibleContexts, TypeOperators, UndecidableInstances, ScopedTypeVariables #-}
1+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeOperators, UndecidableInstances, ScopedTypeVariables, DefaultSignatures #-}
22module ProjectM36.Tupleable where
33import ProjectM36.Base
4+import ProjectM36.Error
45import ProjectM36.Tuple
6+import ProjectM36.TupleSet
57import ProjectM36.Atomable
68import ProjectM36.Attribute hiding (null)
79import GHC.Generics
810import qualified Data.Vector as V
911import qualified Data.Text as T
1012import Data.Monoid
11−
13+import Data.Foldable
14+import Data.Maybe
15+
16+{-
1217data Test1T = Test1C {
1318 attrA :: Int
1419 }
@@ -28,6 +33,15 @@ data TestUnnamed1 = TestUnnamed1 Int Double T.Text
2833 deriving (Show,Eq, Generic)
2934
3035instance Tupleable TestUnnamed1
36+-}
37+
38+-- | Convert a 'Traverseable' of 'Tupleable's to an 'Insert' 'DatabaseContextExpr'. This is useful for converting, for example, a list of data values to a set of Insert expressions which can be used to add the values to the database.
39+toInsertExpr :: (Tupleable a, Traversable t) => t a -> RelVarName -> Either RelationalError DatabaseContextExpr
40+toInsertExpr vals rvName = do
41+ let attrs = toAttributes (head (toList vals))
42+ tuples <- mkTupleSet attrs $ toList (fmap toTuple vals)
43+ let rel = MakeStaticRelation attrs tuples
44+ pure (Insert rvName rel)
3145
3246class Tupleable a where
3347 toTuple :: a -> RelationTuple
@@ -73,7 +87,7 @@ instance (Constructor c, TupleableG a, AtomableG a) => TupleableG (M1 C c a) whe
7387-- product types
7488instance (TupleableG a, TupleableG b) => TupleableG (a :*: b) where
7589 toTupleG = error "toTupleG"
76− toAttributesG (x :*: y) = toAttributesG x V.++ toAttributesG y
90+ toAttributesG ~(x :*: y) = toAttributesG x V.++ toAttributesG y --a bit of extra laziness prevents whnf so that we can use toAttributes (undefined :: Test2T Int Int) without throwing an exception
7791 fromTupleG tup = fromTupleG tup :*: fromTupleG (trimTuple 1 tup)
7892
7993--selector/record
@@ -90,9 +104,7 @@ instance (Selector c, AtomableG a) => TupleableG (M1 S c a) where
90104 Left _ -> error ("no such record name: " ++ name)
91105 Right atom -> M1 (atomv atom)
92106 where
93− atomv atom = case fromAtomG atom [atom] of
94− Nothing -> error "no such atom conversion"
95− Just v -> v
107+ atomv atom = fromMaybe (error "no such atom conversion") (fromAtomG atom [atom])
96108 name = selName (undefined :: M1 S c a x)
97109
98110--constructors with no arguments