@@ -0,0 +1,91 @@
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, DefaultSignatures, FlexibleInstances, FlexibleContexts, TypeOperators #-}
2+module ProjectM36.Tupleable where
4+import ProjectM36.Atomable
6+import qualified Data.Vector as V
7+import qualified Data.Text as T
10+data Test1T = Test1C {
15+data Test2T = Test2C {
21+data Test3T = Test3C Int
27+data Test5T = Test5C1 Int |
31+data Test6T = Test6C T.Text Int Double
34+instance Tupleable Test1T
36+instance Tupleable Test2T
38+instance Tupleable Test3T
40+instance Tupleable Test4T
42+--instance Tupleable Test5T -- should fail at compile time- sum types not supported
44+instance Tupleable Test6T
46+class Tupleable a where
47+ toTuple :: a -> RelationTuple
49+ default toTuple :: (Generic a, TupleableG (Rep a)) => a -> RelationTuple
50+ toTuple v = toTupleG (from v)
52+class TupleableG g where
53+ toTupleG :: g a -> RelationTuple
54+ toAttributesG :: g a -> Attributes
57+instance (Datatype c, TupleableG a) => TupleableG (M1 D c a) where
58+ toTupleG (M1 v) = toTupleG v
59+ toAttributesG = undefined
61+--constructor metadata
62+instance (Constructor c, TupleableG a, AtomableG a) => TupleableG (M1 C c a) where
63+ toTupleG (M1 v) = RelationTuple attrs atoms
65+ attrsToCheck = toAttributesG v
66+ counter = V.generate (V.length attrsToCheck) id
67+ attrs = V.zipWith (\num attr@(Attribute name typ) -> if T.null name then
68+ Attribute ("attr" <> (T.pack (show (num + 1)))) typ
70+ attr) counter attrsToCheck
71+ atoms = V.fromList (toAtomsG v)
72+ toAttributesG = undefined
75+instance (TupleableG a, TupleableG b) => TupleableG (a :*: b) where
77+ toAttributesG (x :*: y) = toAttributesG x V.++ toAttributesG y
80+instance (Selector c, AtomableG a) => TupleableG (M1 S c a) where
82+ toAttributesG m@(M1 v) = V.singleton (Attribute name aType)
84+ name = T.pack (selName m)
85+ aType = toAtomTypeG v
87+--constructors with no arguments
88+--basically useless but orthoganal to relationTrue
89+instance TupleableG U1 where
91+ toAttributesG _ = V.empty