module ProjectM36.DataTypes.Sorting where
import ProjectM36.Base

compareAtoms :: Atom -> Atom -> Ordering
compareAtoms :: Atom -> Atom -> Ordering
compareAtoms (IntegerAtom Integer
i1) (IntegerAtom Integer
i2) = forall a. Ord a => a -> a -> Ordering
compare Integer
i1 Integer
i2
compareAtoms (IntAtom Int
i1) (IntAtom Int
i2) = forall a. Ord a => a -> a -> Ordering
compare Int
i1 Int
i2
compareAtoms (DoubleAtom Double
d1) (DoubleAtom Double
d2) = forall a. Ord a => a -> a -> Ordering
compare Double
d1 Double
d2
compareAtoms (ScientificAtom Scientific
s1) (ScientificAtom Scientific
s2) = forall a. Ord a => a -> a -> Ordering
compare Scientific
s1 Scientific
s2
compareAtoms (TextAtom Text
t1) (TextAtom Text
t2) = forall a. Ord a => a -> a -> Ordering
compare Text
t1 Text
t2
compareAtoms (DayAtom Day
d1) (DayAtom Day
d2) = forall a. Ord a => a -> a -> Ordering
compare Day
d1 Day
d2
compareAtoms (DateTimeAtom UTCTime
d1) (DateTimeAtom UTCTime
d2) = forall a. Ord a => a -> a -> Ordering
compare UTCTime
d1 UTCTime
d2
compareAtoms (ByteStringAtom ByteString
b1) (ByteStringAtom ByteString
b2) = forall a. Ord a => a -> a -> Ordering
compare ByteString
b1 ByteString
b2
compareAtoms (BoolAtom Bool
b1) (BoolAtom Bool
b2) = forall a. Ord a => a -> a -> Ordering
compare Bool
b1 Bool
b2
compareAtoms (UUIDAtom UUID
u1) (UUIDAtom UUID
u2) = forall a. Ord a => a -> a -> Ordering
compare UUID
u1 UUID
u2
compareAtoms (RelationAtom Relation
_) Atom
_ = Ordering
EQ
compareAtoms ConstructedAtom{} Atom
_ = Ordering
EQ
compareAtoms Atom
_ Atom
_ = Ordering
EQ

isSortableAtomType :: AtomType -> Bool
isSortableAtomType :: AtomType -> Bool
isSortableAtomType AtomType
typ = case AtomType
typ of
  AtomType
IntAtomType -> Bool
True
  AtomType
IntegerAtomType -> Bool
True
  AtomType
DoubleAtomType -> Bool
True
  AtomType
ScientificAtomType -> Bool
True
  AtomType
TextAtomType -> Bool
True
  AtomType
DayAtomType -> Bool
True
  AtomType
DateTimeAtomType -> Bool
True
  AtomType
ByteStringAtomType -> Bool
False
  AtomType
BoolAtomType -> Bool
True
  AtomType
UUIDAtomType -> Bool
False
  AtomType
RelationalExprAtomType -> Bool
False
  RelationAtomType Attributes
_ -> Bool
False
  ConstructedAtomType Text
_ TypeVarMap
_ -> Bool
False
  TypeVariableType Text
_ -> Bool
False