@@ -57,63 +57,16 @@ instance Atomable Relation
5757instance (Atomable a) => Atomable (Maybe a)
5858
5959-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
60−data Atom = forall a. Atomable a => Atom a |
60+data Atom = IntAtom Int |
61+ DoubleAtom Double |
62+ TextAtom Text |
63+ DayAtom Day |
64+ DateTimeAtom UTCTime |
65+ ByteStringAtom ByteString |
66+ BoolAtom Bool |
67+ RelationAtom Relation |
6168 ConstructedAtom DataConstructorName AtomType [Atom]
62−
63−instance Eq Atom where
64− (Atom a) == (Atom b) = Just a == cast b
65− (ConstructedAtom dConsNameA aTypeA atomListA) == (ConstructedAtom dConsNameB aTypeB atomListB) = aTypeA == aTypeB &&
66− atomListA == atomListB &&
67− dConsNameA == dConsNameB
68− _ == _ = False
69−
70−instance Show Atom where
71− showsPrec _ (Atom atom) = showString "Atom " . shows atom
72− showsPrec v (ConstructedAtom dConsName _ atomList) = showParen (v >= 4) showIt
73− where showIt = showString (unpack dConsName) . showString " " . compose (map (showsPrec 4) atomList)
74− compose = foldr (.) id
75−
76−instance Binary Atom where
77− put atom@(Atom val) = put (atomTypeForAtom atom) >> put val
78− put (ConstructedAtom dConsName aType atomList) = put aType >> put dConsName >> put atomList
79− get = do
80− atomtype <- get
81− --not-so-great for this to be hardcoded here- it would be nicer to have a dispatch table linked to the instances themselves
82− --http://stackoverflow.com/questions/8101067/binary-instance-for-an-existential
83− case atomtype of
84− AnyAtomType -> error "unsupported serialization AnyAtomType"
85− caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> (get :: Get DataConstructorName) <*> pure caType <*> (get :: Get [Atom]) --we really should verify the type with the atoms
86− (RelationAtomType _) -> Atom <$> (get :: Get Relation)
87− (AtomType cTypeRep) -> if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then
88− Atom <$> (get :: Get Int)
89− else if unCTR cTypeRep == typeRep (Proxy :: Proxy Text) then
90− Atom <$> (get :: Get Text)
91− else if unCTR cTypeRep == typeRep (Proxy :: Proxy Double) then
92− Atom <$> (get :: Get Double)
93− else if unCTR cTypeRep == typeRep (Proxy :: Proxy Day) then
94− Atom <$> (get :: Get Day)
95− else if unCTR cTypeRep == typeRep (Proxy :: Proxy ByteString) then
96− Atom <$> (get :: Get ByteString)
97− else if unCTR cTypeRep == typeRep (Proxy :: Proxy Bool) then
98− Atom <$> (get :: Get Bool)
99− else
100− error "unsupported typerep serialization"
101−
102−instance NFData Atom where
103− rnf !(Atom a) = rnf a
104− rnf !(ConstructedAtom dConsName aType atomList) = rnf (dConsName, atomList, aType)
105−
106−instance Hashable Atom where
107− hashWithSalt salt (Atom a) = hashWithSalt salt a
108− hashWithSalt salt (ConstructedAtom dConsName _ atomList) = salt `hashWithSalt` atomList
109− `hashWithSalt` dConsName --AtomType is not hashable
110−
111−-- | Return the type of an 'Atom'.
112−atomTypeForAtom :: Atom -> AtomType
113−atomTypeForAtom (Atom atom) = case cast atom of
114− Just (Relation attrs _) -> RelationAtomType attrs
115− Nothing -> AtomType $ CTR (typeOf atom)
116−atomTypeForAtom (ConstructedAtom _ aType _) = aType
69+ deriving (Eq, Show, Hashable, Binary, Typeable, NFData)
11770
11871instance Binary UTCTime where
11972 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)
@@ -129,12 +82,18 @@ instance Binary Day where
12982
13083-- I suspect the definition of ConstructedAtomType with its name alone is insufficient to disambiguate the cases; for example, one could create a type named X, remove a type named X, and re-add it using different constructors. However, as long as requests are served from only one DatabaseContext at-a-time, the type name is unambiguous. This will become a problem for time-travel, however.
13184-- | The AtomType must uniquely identify the type of a atom.
132−data AtomType = AtomType ConcreteTypeRep |
85+data AtomType = IntAtomType |
86+ DoubleAtomType |
87+ TextAtomType |
88+ DayAtomType |
89+ DateTimeAtomType |
90+ ByteStringAtomType |
91+ BoolAtomType |
13392 RelationAtomType Attributes |
13493 ConstructedAtomType TypeConstructorName TypeVarMap |
13594 AnyAtomType
13695 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor
137− deriving (Eq,NFData,Generic,Binary, Show)
96+ deriving (Eq,NFData,Generic,Binary, Show, Hashable)
13897
13998type TypeVarMap = M.Map TypeVarName AtomType
14099