@@ -10,19 +10,30 @@ import qualified Data.Map as M
1010--import Debug.Trace
1111
1212data TestT = TestC Int
13− deriving (Generic, Show)
13+ deriving (Generic, Show, Eq)
1414
1515data Test2T x = Test2C x
16− deriving (Show, Generic)
17−
16+ deriving (Show, Generic, Eq)
17+
18+data Test3T = Test3C Int Int
19+ deriving (Show, Generic, Eq)
20+
21+data Test4T = Test4Ca Int |
22+ Test4Cb Int
23+ deriving (Show, Generic, Eq)
24+
25+data TyTest a = TyTest a
26+
1827instance Atomable TestT
1928instance Atomable a => Atomable (Test2T a)
29+instance Atomable Test3T
30+--instance Atomable Test4T
2031
21−class Atomable a where
32+class (Eq a, Show a) => Atomable a where
2233 --type AtomT a
2334 toAtom :: a -> Atom
2435 default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom
25− toAtom v = toAtomG (from v)
36+ toAtom v = toAtomG (from v) (toAtomTypeG (from v))
2637
2738 toAtomType :: a -> AtomType
2839 default toAtomType :: (Generic a, AtomableG (Rep a)) => a -> AtomType
@@ -32,23 +43,17 @@ instance Atomable Int where
3243 toAtom i = IntAtom i
3344 toAtomType _ = IntAtomType
3445
35−instance Atomable Text where
46+instance Atomable T.Text where
3647 toAtom i = TextAtom i
3748 toAtomType _ = TextAtomType
3849
3950-- Generics
4051class AtomableG g where
4152 --type AtomTG g
42− toAtomG :: g a -> Atom
53+ toAtomG :: g a -> AtomType -> Atom
4354 toAtomTypeG :: g a -> AtomType --overall ConstructedAtomType
44− toAtomTypesG :: g a -> [AtomType] --built from individual atom types
55+ toAtomsG :: g a -> [Atom]
4556
46−{-
47−instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
48− --type AtomTG (a :*: b) = (AtomTG a, AtomTG b)
49− toAtomG v = undefined
50− toAtomTypeG v = undefined
51−-}
5257-- Right | Left
5358 {-
5459instance (AtomableG (a p), AtomableG (b p)) => AtomableG ((a :+: b) p) where
@@ -64,48 +69,33 @@ instance (Atomable (a p), Atomable (b p)) => AtomableG ((a :*: b) p) where
6469
6570--data type metadata
6671instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where
67− --type AtomTG (M1 D c a) = AtomTG a
68− toAtomG = undefined
69− toAtomTypesG = undefined
70− toAtomTypeG (M1 v) = ConstructedAtomType (T.pack typeName) tvMap
72+ toAtomG (M1 v) t = toAtomG v t
73+ toAtomsG = undefined
74+ toAtomTypeG _ = ConstructedAtomType (T.pack typeName) M.empty -- generics don't allow us to get the type constructor variables- alternatives?
7175 where
72− aTypes = toAtomTypesG v
73− a2z = map T.singleton ['a'..'z']
74− tvMap = M.fromList (zip a2z aTypes)
7576 typeName = datatypeName (undefined :: M1 D c a x)
7677
7778
7879instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where
79− --M.Map TypeVarName AtomType
8080 --constructor name needed for Atom but not for atomType
81− toAtomG (M1 _) = ConstructedAtom (T.pack constructorName) AnyAtomType []
81+ toAtomG (M1 v) t = ConstructedAtom (T.pack constructorName) t atoms
8282 where
83+ atoms = toAtomsG v
8384 constructorName = conName (undefined :: M1 C c a x)
85+ toAtomsG = undefined
8486 toAtomTypeG = undefined
85− toAtomTypesG (M1 v) = toAtomTypesG v
8687
87−instance Atomable f => AtomableG (M1 S c (Rec0 f)) where
88+instance (Selector c, AtomableG a) => AtomableG (M1 S c a) where
8889 toAtomG = undefined
89− toAtomTypeG = undefined
90− toAtomTypesG _ = [toAtomType (undefined :: f)]
90+ toAtomsG (M1 v) = toAtomsG v
91+ toAtomTypeG (M1 v) = toAtomTypeG v
9192
92−{-
93−--constructor metadata
94−instance AtomableG a => AtomableG (M1 C c a) where
95− --type AtomTG (M1 C c a) = AtomTG a
96− toAtomG v = undefined
97− toAtomTypeG v =
98−
99−--record selector metdata
100−instance (Selector c, AtomableG a) => AtomableG (M1 S c a) where
101− --type AtomTG (M1 S c a) = AtomTG a
102− toAtomG v = undefined
103− toAtomTypeG v = undefined
93+instance (Atomable a) => AtomableG (K1 c a) where
94+ toAtomG (K1 v) _ = toAtom v
95+ toAtomsG (K1 v) = [toAtom v]
96+ toAtomTypeG (K1 v) = toAtomType (undefined :: a)
10497
105−--constants or recursion
106−instance Atomable a => AtomableG (K1 i a) where
107− --type AtomTG (K1 i s) = AtomT s
108−
109−toAtomG (K1 a) = toAtom a
110− toAtomTypeG = undefined
111−-}
98+instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
99+ toAtomG = undefined
100+ toAtomTypeG = undefined
101+ toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y