module Hydra.Ext.Tinkerpop.Typed where
import qualified Hydra.Core as Core
import Data.List
import Data.Map
import Data.Set
data CollectionType =
CollectionTypeList Type |
CollectionTypeMap Type |
CollectionTypeOptional Type |
CollectionTypeSet Type
deriving (CollectionType -> CollectionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectionType -> CollectionType -> Bool
$c/= :: CollectionType -> CollectionType -> Bool
== :: CollectionType -> CollectionType -> Bool
$c== :: CollectionType -> CollectionType -> Bool
Eq, Eq CollectionType
CollectionType -> CollectionType -> Bool
CollectionType -> CollectionType -> Ordering
CollectionType -> CollectionType -> CollectionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CollectionType -> CollectionType -> CollectionType
$cmin :: CollectionType -> CollectionType -> CollectionType
max :: CollectionType -> CollectionType -> CollectionType
$cmax :: CollectionType -> CollectionType -> CollectionType
>= :: CollectionType -> CollectionType -> Bool
$c>= :: CollectionType -> CollectionType -> Bool
> :: CollectionType -> CollectionType -> Bool
$c> :: CollectionType -> CollectionType -> Bool
<= :: CollectionType -> CollectionType -> Bool
$c<= :: CollectionType -> CollectionType -> Bool
< :: CollectionType -> CollectionType -> Bool
$c< :: CollectionType -> CollectionType -> Bool
compare :: CollectionType -> CollectionType -> Ordering
$ccompare :: CollectionType -> CollectionType -> Ordering
Ord, ReadPrec [CollectionType]
ReadPrec CollectionType
Int -> ReadS CollectionType
ReadS [CollectionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CollectionType]
$creadListPrec :: ReadPrec [CollectionType]
readPrec :: ReadPrec CollectionType
$creadPrec :: ReadPrec CollectionType
readList :: ReadS [CollectionType]
$creadList :: ReadS [CollectionType]
readsPrec :: Int -> ReadS CollectionType
$creadsPrec :: Int -> ReadS CollectionType
Read, Int -> CollectionType -> ShowS
[CollectionType] -> ShowS
CollectionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectionType] -> ShowS
$cshowList :: [CollectionType] -> ShowS
show :: CollectionType -> String
$cshow :: CollectionType -> String
showsPrec :: Int -> CollectionType -> ShowS
$cshowsPrec :: Int -> CollectionType -> ShowS
Show)
_CollectionType :: Name
_CollectionType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.CollectionType")
_CollectionType_list :: FieldName
_CollectionType_list = (String -> FieldName
Core.FieldName String
"list")
_CollectionType_map :: FieldName
_CollectionType_map = (String -> FieldName
Core.FieldName String
"map")
_CollectionType_optional :: FieldName
_CollectionType_optional = (String -> FieldName
Core.FieldName String
"optional")
_CollectionType_set :: FieldName
_CollectionType_set = (String -> FieldName
Core.FieldName String
"set")
data CollectionValue =
CollectionValueList [Value] |
CollectionValueMap (Map Key Value) |
CollectionValueOptional (Maybe Value) |
CollectionValueSet (Set Value)
deriving (CollectionValue -> CollectionValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectionValue -> CollectionValue -> Bool
$c/= :: CollectionValue -> CollectionValue -> Bool
== :: CollectionValue -> CollectionValue -> Bool
$c== :: CollectionValue -> CollectionValue -> Bool
Eq, Eq CollectionValue
CollectionValue -> CollectionValue -> Bool
CollectionValue -> CollectionValue -> Ordering
CollectionValue -> CollectionValue -> CollectionValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CollectionValue -> CollectionValue -> CollectionValue
$cmin :: CollectionValue -> CollectionValue -> CollectionValue
max :: CollectionValue -> CollectionValue -> CollectionValue
$cmax :: CollectionValue -> CollectionValue -> CollectionValue
>= :: CollectionValue -> CollectionValue -> Bool
$c>= :: CollectionValue -> CollectionValue -> Bool
> :: CollectionValue -> CollectionValue -> Bool
$c> :: CollectionValue -> CollectionValue -> Bool
<= :: CollectionValue -> CollectionValue -> Bool
$c<= :: CollectionValue -> CollectionValue -> Bool
< :: CollectionValue -> CollectionValue -> Bool
$c< :: CollectionValue -> CollectionValue -> Bool
compare :: CollectionValue -> CollectionValue -> Ordering
$ccompare :: CollectionValue -> CollectionValue -> Ordering
Ord, ReadPrec [CollectionValue]
ReadPrec CollectionValue
Int -> ReadS CollectionValue
ReadS [CollectionValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CollectionValue]
$creadListPrec :: ReadPrec [CollectionValue]
readPrec :: ReadPrec CollectionValue
$creadPrec :: ReadPrec CollectionValue
readList :: ReadS [CollectionValue]
$creadList :: ReadS [CollectionValue]
readsPrec :: Int -> ReadS CollectionValue
$creadsPrec :: Int -> ReadS CollectionValue
Read, Int -> CollectionValue -> ShowS
[CollectionValue] -> ShowS
CollectionValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectionValue] -> ShowS
$cshowList :: [CollectionValue] -> ShowS
show :: CollectionValue -> String
$cshow :: CollectionValue -> String
showsPrec :: Int -> CollectionValue -> ShowS
$cshowsPrec :: Int -> CollectionValue -> ShowS
Show)
_CollectionValue :: Name
_CollectionValue = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.CollectionValue")
_CollectionValue_list :: FieldName
_CollectionValue_list = (String -> FieldName
Core.FieldName String
"list")
_CollectionValue_map :: FieldName
_CollectionValue_map = (String -> FieldName
Core.FieldName String
"map")
_CollectionValue_optional :: FieldName
_CollectionValue_optional = (String -> FieldName
Core.FieldName String
"optional")
_CollectionValue_set :: FieldName
_CollectionValue_set = (String -> FieldName
Core.FieldName String
"set")
data Edge =
Edge {
Edge -> EdgeId
edgeId :: EdgeId,
Edge -> Label
edgeLabel :: Label,
Edge -> VertexId
edgeOut :: VertexId,
Edge -> VertexId
edgeIn :: VertexId,
Edge -> Map Key Value
edgeProperties :: (Map Key Value)}
deriving (Edge -> Edge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Eq Edge
Edge -> Edge -> Bool
Edge -> Edge -> Ordering
Edge -> Edge -> Edge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmax :: Edge -> Edge -> Edge
>= :: Edge -> Edge -> Bool
$c>= :: Edge -> Edge -> Bool
> :: Edge -> Edge -> Bool
$c> :: Edge -> Edge -> Bool
<= :: Edge -> Edge -> Bool
$c<= :: Edge -> Edge -> Bool
< :: Edge -> Edge -> Bool
$c< :: Edge -> Edge -> Bool
compare :: Edge -> Edge -> Ordering
$ccompare :: Edge -> Edge -> Ordering
Ord, ReadPrec [Edge]
ReadPrec Edge
Int -> ReadS Edge
ReadS [Edge]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Edge]
$creadListPrec :: ReadPrec [Edge]
readPrec :: ReadPrec Edge
$creadPrec :: ReadPrec Edge
readList :: ReadS [Edge]
$creadList :: ReadS [Edge]
readsPrec :: Int -> ReadS Edge
$creadsPrec :: Int -> ReadS Edge
Read, Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edge] -> ShowS
$cshowList :: [Edge] -> ShowS
show :: Edge -> String
$cshow :: Edge -> String
showsPrec :: Int -> Edge -> ShowS
$cshowsPrec :: Int -> Edge -> ShowS
Show)
_Edge :: Name
_Edge = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Edge")
_Edge_id :: FieldName
_Edge_id = (String -> FieldName
Core.FieldName String
"id")
_Edge_label :: FieldName
_Edge_label = (String -> FieldName
Core.FieldName String
"label")
_Edge_out :: FieldName
_Edge_out = (String -> FieldName
Core.FieldName String
"out")
_Edge_in :: FieldName
_Edge_in = (String -> FieldName
Core.FieldName String
"in")
_Edge_properties :: FieldName
_Edge_properties = (String -> FieldName
Core.FieldName String
"properties")
newtype EdgeId =
EdgeId {
EdgeId -> Literal
unEdgeId :: Core.Literal}
deriving (EdgeId -> EdgeId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeId -> EdgeId -> Bool
$c/= :: EdgeId -> EdgeId -> Bool
== :: EdgeId -> EdgeId -> Bool
$c== :: EdgeId -> EdgeId -> Bool
Eq, Eq EdgeId
EdgeId -> EdgeId -> Bool
EdgeId -> EdgeId -> Ordering
EdgeId -> EdgeId -> EdgeId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EdgeId -> EdgeId -> EdgeId
$cmin :: EdgeId -> EdgeId -> EdgeId
max :: EdgeId -> EdgeId -> EdgeId
$cmax :: EdgeId -> EdgeId -> EdgeId
>= :: EdgeId -> EdgeId -> Bool
$c>= :: EdgeId -> EdgeId -> Bool
> :: EdgeId -> EdgeId -> Bool
$c> :: EdgeId -> EdgeId -> Bool
<= :: EdgeId -> EdgeId -> Bool
$c<= :: EdgeId -> EdgeId -> Bool
< :: EdgeId -> EdgeId -> Bool
$c< :: EdgeId -> EdgeId -> Bool
compare :: EdgeId -> EdgeId -> Ordering
$ccompare :: EdgeId -> EdgeId -> Ordering
Ord, ReadPrec [EdgeId]
ReadPrec EdgeId
Int -> ReadS EdgeId
ReadS [EdgeId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EdgeId]
$creadListPrec :: ReadPrec [EdgeId]
readPrec :: ReadPrec EdgeId
$creadPrec :: ReadPrec EdgeId
readList :: ReadS [EdgeId]
$creadList :: ReadS [EdgeId]
readsPrec :: Int -> ReadS EdgeId
$creadsPrec :: Int -> ReadS EdgeId
Read, Int -> EdgeId -> ShowS
[EdgeId] -> ShowS
EdgeId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeId] -> ShowS
$cshowList :: [EdgeId] -> ShowS
show :: EdgeId -> String
$cshow :: EdgeId -> String
showsPrec :: Int -> EdgeId -> ShowS
$cshowsPrec :: Int -> EdgeId -> ShowS
Show)
_EdgeId :: Name
_EdgeId = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.EdgeId")
newtype EdgeIdType =
EdgeIdType {
EdgeIdType -> EdgeType
unEdgeIdType :: EdgeType}
deriving (EdgeIdType -> EdgeIdType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeIdType -> EdgeIdType -> Bool
$c/= :: EdgeIdType -> EdgeIdType -> Bool
== :: EdgeIdType -> EdgeIdType -> Bool
$c== :: EdgeIdType -> EdgeIdType -> Bool
Eq, Eq EdgeIdType
EdgeIdType -> EdgeIdType -> Bool
EdgeIdType -> EdgeIdType -> Ordering
EdgeIdType -> EdgeIdType -> EdgeIdType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EdgeIdType -> EdgeIdType -> EdgeIdType
$cmin :: EdgeIdType -> EdgeIdType -> EdgeIdType
max :: EdgeIdType -> EdgeIdType -> EdgeIdType
$cmax :: EdgeIdType -> EdgeIdType -> EdgeIdType
>= :: EdgeIdType -> EdgeIdType -> Bool
$c>= :: EdgeIdType -> EdgeIdType -> Bool
> :: EdgeIdType -> EdgeIdType -> Bool
$c> :: EdgeIdType -> EdgeIdType -> Bool
<= :: EdgeIdType -> EdgeIdType -> Bool
$c<= :: EdgeIdType -> EdgeIdType -> Bool
< :: EdgeIdType -> EdgeIdType -> Bool
$c< :: EdgeIdType -> EdgeIdType -> Bool
compare :: EdgeIdType -> EdgeIdType -> Ordering
$ccompare :: EdgeIdType -> EdgeIdType -> Ordering
Ord, ReadPrec [EdgeIdType]
ReadPrec EdgeIdType
Int -> ReadS EdgeIdType
ReadS [EdgeIdType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EdgeIdType]
$creadListPrec :: ReadPrec [EdgeIdType]
readPrec :: ReadPrec EdgeIdType
$creadPrec :: ReadPrec EdgeIdType
readList :: ReadS [EdgeIdType]
$creadList :: ReadS [EdgeIdType]
readsPrec :: Int -> ReadS EdgeIdType
$creadsPrec :: Int -> ReadS EdgeIdType
Read, Int -> EdgeIdType -> ShowS
[EdgeIdType] -> ShowS
EdgeIdType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeIdType] -> ShowS
$cshowList :: [EdgeIdType] -> ShowS
show :: EdgeIdType -> String
$cshow :: EdgeIdType -> String
showsPrec :: Int -> EdgeIdType -> ShowS
$cshowsPrec :: Int -> EdgeIdType -> ShowS
Show)
_EdgeIdType :: Name
_EdgeIdType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.EdgeIdType")
data EdgeType =
EdgeType {
EdgeType -> LiteralType
edgeTypeId :: Core.LiteralType,
EdgeType -> VertexIdType
edgeTypeOut :: VertexIdType,
EdgeType -> VertexIdType
edgeTypeIn :: VertexIdType,
EdgeType -> Map Key Type
edgeTypeProperties :: (Map Key Type)}
deriving (EdgeType -> EdgeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeType -> EdgeType -> Bool
$c/= :: EdgeType -> EdgeType -> Bool
== :: EdgeType -> EdgeType -> Bool
$c== :: EdgeType -> EdgeType -> Bool
Eq, Eq EdgeType
EdgeType -> EdgeType -> Bool
EdgeType -> EdgeType -> Ordering
EdgeType -> EdgeType -> EdgeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EdgeType -> EdgeType -> EdgeType
$cmin :: EdgeType -> EdgeType -> EdgeType
max :: EdgeType -> EdgeType -> EdgeType
$cmax :: EdgeType -> EdgeType -> EdgeType
>= :: EdgeType -> EdgeType -> Bool
$c>= :: EdgeType -> EdgeType -> Bool
> :: EdgeType -> EdgeType -> Bool
$c> :: EdgeType -> EdgeType -> Bool
<= :: EdgeType -> EdgeType -> Bool
$c<= :: EdgeType -> EdgeType -> Bool
< :: EdgeType -> EdgeType -> Bool
$c< :: EdgeType -> EdgeType -> Bool
compare :: EdgeType -> EdgeType -> Ordering
$ccompare :: EdgeType -> EdgeType -> Ordering
Ord, ReadPrec [EdgeType]
ReadPrec EdgeType
Int -> ReadS EdgeType
ReadS [EdgeType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EdgeType]
$creadListPrec :: ReadPrec [EdgeType]
readPrec :: ReadPrec EdgeType
$creadPrec :: ReadPrec EdgeType
readList :: ReadS [EdgeType]
$creadList :: ReadS [EdgeType]
readsPrec :: Int -> ReadS EdgeType
$creadsPrec :: Int -> ReadS EdgeType
Read, Int -> EdgeType -> ShowS
[EdgeType] -> ShowS
EdgeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeType] -> ShowS
$cshowList :: [EdgeType] -> ShowS
show :: EdgeType -> String
$cshow :: EdgeType -> String
showsPrec :: Int -> EdgeType -> ShowS
$cshowsPrec :: Int -> EdgeType -> ShowS
Show)
_EdgeType :: Name
_EdgeType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.EdgeType")
_EdgeType_id :: FieldName
_EdgeType_id = (String -> FieldName
Core.FieldName String
"id")
_EdgeType_out :: FieldName
_EdgeType_out = (String -> FieldName
Core.FieldName String
"out")
_EdgeType_in :: FieldName
_EdgeType_in = (String -> FieldName
Core.FieldName String
"in")
_EdgeType_properties :: FieldName
_EdgeType_properties = (String -> FieldName
Core.FieldName String
"properties")
data Id =
IdVertex VertexId |
IdEdge EdgeId
deriving (Id -> Id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
Ord, ReadPrec [Id]
ReadPrec Id
Int -> ReadS Id
ReadS [Id]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Id]
$creadListPrec :: ReadPrec [Id]
readPrec :: ReadPrec Id
$creadPrec :: ReadPrec Id
readList :: ReadS [Id]
$creadList :: ReadS [Id]
readsPrec :: Int -> ReadS Id
$creadsPrec :: Int -> ReadS Id
Read, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)
_Id :: Name
_Id = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Id")
_Id_vertex :: FieldName
_Id_vertex = (String -> FieldName
Core.FieldName String
"vertex")
_Id_edge :: FieldName
_Id_edge = (String -> FieldName
Core.FieldName String
"edge")
data IdType =
IdTypeVertex VertexType |
IdTypeEdge EdgeType
deriving (IdType -> IdType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdType -> IdType -> Bool
$c/= :: IdType -> IdType -> Bool
== :: IdType -> IdType -> Bool
$c== :: IdType -> IdType -> Bool
Eq, Eq IdType
IdType -> IdType -> Bool
IdType -> IdType -> Ordering
IdType -> IdType -> IdType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IdType -> IdType -> IdType
$cmin :: IdType -> IdType -> IdType
max :: IdType -> IdType -> IdType
$cmax :: IdType -> IdType -> IdType
>= :: IdType -> IdType -> Bool
$c>= :: IdType -> IdType -> Bool
> :: IdType -> IdType -> Bool
$c> :: IdType -> IdType -> Bool
<= :: IdType -> IdType -> Bool
$c<= :: IdType -> IdType -> Bool
< :: IdType -> IdType -> Bool
$c< :: IdType -> IdType -> Bool
compare :: IdType -> IdType -> Ordering
$ccompare :: IdType -> IdType -> Ordering
Ord, ReadPrec [IdType]
ReadPrec IdType
Int -> ReadS IdType
ReadS [IdType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IdType]
$creadListPrec :: ReadPrec [IdType]
readPrec :: ReadPrec IdType
$creadPrec :: ReadPrec IdType
readList :: ReadS [IdType]
$creadList :: ReadS [IdType]
readsPrec :: Int -> ReadS IdType
$creadsPrec :: Int -> ReadS IdType
Read, Int -> IdType -> ShowS
[IdType] -> ShowS
IdType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdType] -> ShowS
$cshowList :: [IdType] -> ShowS
show :: IdType -> String
$cshow :: IdType -> String
showsPrec :: Int -> IdType -> ShowS
$cshowsPrec :: Int -> IdType -> ShowS
Show)
_IdType :: Name
_IdType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.IdType")
_IdType_vertex :: FieldName
_IdType_vertex = (String -> FieldName
Core.FieldName String
"vertex")
_IdType_edge :: FieldName
_IdType_edge = (String -> FieldName
Core.FieldName String
"edge")
newtype Key =
Key {
Key -> String
unKey :: String}
deriving (Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
Ord, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
_Key :: Name
_Key = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Key")
newtype Label =
Label {
Label -> String
unLabel :: String}
deriving (Label -> Label -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
Ord, ReadPrec [Label]
ReadPrec Label
Int -> ReadS Label
ReadS [Label]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Label]
$creadListPrec :: ReadPrec [Label]
readPrec :: ReadPrec Label
$creadPrec :: ReadPrec Label
readList :: ReadS [Label]
$creadList :: ReadS [Label]
readsPrec :: Int -> ReadS Label
$creadsPrec :: Int -> ReadS Label
Read, Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)
_Label :: Name
_Label = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Label")
data Type =
TypeLiteral Core.LiteralType |
TypeCollection CollectionType |
TypeElement IdType
deriving (Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)
_Type :: Name
_Type = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Type")
_Type_literal :: FieldName
_Type_literal = (String -> FieldName
Core.FieldName String
"literal")
_Type_collection :: FieldName
_Type_collection = (String -> FieldName
Core.FieldName String
"collection")
_Type_element :: FieldName
_Type_element = (String -> FieldName
Core.FieldName String
"element")
data Value =
ValueLiteral Core.Literal |
ValueCollection CollectionValue |
ValueElement Id
deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Eq Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
Ord, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Value]
$creadListPrec :: ReadPrec [Value]
readPrec :: ReadPrec Value
$creadPrec :: ReadPrec Value
readList :: ReadS [Value]
$creadList :: ReadS [Value]
readsPrec :: Int -> ReadS Value
$creadsPrec :: Int -> ReadS Value
Read, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)
_Value :: Name
_Value = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Value")
_Value_literal :: FieldName
_Value_literal = (String -> FieldName
Core.FieldName String
"literal")
_Value_collection :: FieldName
_Value_collection = (String -> FieldName
Core.FieldName String
"collection")
_Value_element :: FieldName
_Value_element = (String -> FieldName
Core.FieldName String
"element")
data Vertex =
Vertex {
Vertex -> VertexId
vertexId :: VertexId,
Vertex -> Label
vertexLabel :: Label,
Vertex -> Map Key Value
vertexProperties :: (Map Key Value)}
deriving (Vertex -> Vertex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex -> Vertex -> Bool
$c/= :: Vertex -> Vertex -> Bool
== :: Vertex -> Vertex -> Bool
$c== :: Vertex -> Vertex -> Bool
Eq, Eq Vertex
Vertex -> Vertex -> Bool
Vertex -> Vertex -> Ordering
Vertex -> Vertex -> Vertex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vertex -> Vertex -> Vertex
$cmin :: Vertex -> Vertex -> Vertex
max :: Vertex -> Vertex -> Vertex
$cmax :: Vertex -> Vertex -> Vertex
>= :: Vertex -> Vertex -> Bool
$c>= :: Vertex -> Vertex -> Bool
> :: Vertex -> Vertex -> Bool
$c> :: Vertex -> Vertex -> Bool
<= :: Vertex -> Vertex -> Bool
$c<= :: Vertex -> Vertex -> Bool
< :: Vertex -> Vertex -> Bool
$c< :: Vertex -> Vertex -> Bool
compare :: Vertex -> Vertex -> Ordering
$ccompare :: Vertex -> Vertex -> Ordering
Ord, ReadPrec [Vertex]
ReadPrec Vertex
Int -> ReadS Vertex
ReadS [Vertex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Vertex]
$creadListPrec :: ReadPrec [Vertex]
readPrec :: ReadPrec Vertex
$creadPrec :: ReadPrec Vertex
readList :: ReadS [Vertex]
$creadList :: ReadS [Vertex]
readsPrec :: Int -> ReadS Vertex
$creadsPrec :: Int -> ReadS Vertex
Read, Int -> Vertex -> ShowS
[Vertex] -> ShowS
Vertex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertex] -> ShowS
$cshowList :: [Vertex] -> ShowS
show :: Vertex -> String
$cshow :: Vertex -> String
showsPrec :: Int -> Vertex -> ShowS
$cshowsPrec :: Int -> Vertex -> ShowS
Show)
_Vertex :: Name
_Vertex = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.Vertex")
_Vertex_id :: FieldName
_Vertex_id = (String -> FieldName
Core.FieldName String
"id")
_Vertex_label :: FieldName
_Vertex_label = (String -> FieldName
Core.FieldName String
"label")
_Vertex_properties :: FieldName
_Vertex_properties = (String -> FieldName
Core.FieldName String
"properties")
newtype VertexId =
VertexId {
VertexId -> Literal
unVertexId :: Core.Literal}
deriving (VertexId -> VertexId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexId -> VertexId -> Bool
$c/= :: VertexId -> VertexId -> Bool
== :: VertexId -> VertexId -> Bool
$c== :: VertexId -> VertexId -> Bool
Eq, Eq VertexId
VertexId -> VertexId -> Bool
VertexId -> VertexId -> Ordering
VertexId -> VertexId -> VertexId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexId -> VertexId -> VertexId
$cmin :: VertexId -> VertexId -> VertexId
max :: VertexId -> VertexId -> VertexId
$cmax :: VertexId -> VertexId -> VertexId
>= :: VertexId -> VertexId -> Bool
$c>= :: VertexId -> VertexId -> Bool
> :: VertexId -> VertexId -> Bool
$c> :: VertexId -> VertexId -> Bool
<= :: VertexId -> VertexId -> Bool
$c<= :: VertexId -> VertexId -> Bool
< :: VertexId -> VertexId -> Bool
$c< :: VertexId -> VertexId -> Bool
compare :: VertexId -> VertexId -> Ordering
$ccompare :: VertexId -> VertexId -> Ordering
Ord, ReadPrec [VertexId]
ReadPrec VertexId
Int -> ReadS VertexId
ReadS [VertexId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VertexId]
$creadListPrec :: ReadPrec [VertexId]
readPrec :: ReadPrec VertexId
$creadPrec :: ReadPrec VertexId
readList :: ReadS [VertexId]
$creadList :: ReadS [VertexId]
readsPrec :: Int -> ReadS VertexId
$creadsPrec :: Int -> ReadS VertexId
Read, Int -> VertexId -> ShowS
[VertexId] -> ShowS
VertexId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexId] -> ShowS
$cshowList :: [VertexId] -> ShowS
show :: VertexId -> String
$cshow :: VertexId -> String
showsPrec :: Int -> VertexId -> ShowS
$cshowsPrec :: Int -> VertexId -> ShowS
Show)
_VertexId :: Name
_VertexId = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.VertexId")
newtype VertexIdType =
VertexIdType {
VertexIdType -> VertexType
unVertexIdType :: VertexType}
deriving (VertexIdType -> VertexIdType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexIdType -> VertexIdType -> Bool
$c/= :: VertexIdType -> VertexIdType -> Bool
== :: VertexIdType -> VertexIdType -> Bool
$c== :: VertexIdType -> VertexIdType -> Bool
Eq, Eq VertexIdType
VertexIdType -> VertexIdType -> Bool
VertexIdType -> VertexIdType -> Ordering
VertexIdType -> VertexIdType -> VertexIdType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexIdType -> VertexIdType -> VertexIdType
$cmin :: VertexIdType -> VertexIdType -> VertexIdType
max :: VertexIdType -> VertexIdType -> VertexIdType
$cmax :: VertexIdType -> VertexIdType -> VertexIdType
>= :: VertexIdType -> VertexIdType -> Bool
$c>= :: VertexIdType -> VertexIdType -> Bool
> :: VertexIdType -> VertexIdType -> Bool
$c> :: VertexIdType -> VertexIdType -> Bool
<= :: VertexIdType -> VertexIdType -> Bool
$c<= :: VertexIdType -> VertexIdType -> Bool
< :: VertexIdType -> VertexIdType -> Bool
$c< :: VertexIdType -> VertexIdType -> Bool
compare :: VertexIdType -> VertexIdType -> Ordering
$ccompare :: VertexIdType -> VertexIdType -> Ordering
Ord, ReadPrec [VertexIdType]
ReadPrec VertexIdType
Int -> ReadS VertexIdType
ReadS [VertexIdType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VertexIdType]
$creadListPrec :: ReadPrec [VertexIdType]
readPrec :: ReadPrec VertexIdType
$creadPrec :: ReadPrec VertexIdType
readList :: ReadS [VertexIdType]
$creadList :: ReadS [VertexIdType]
readsPrec :: Int -> ReadS VertexIdType
$creadsPrec :: Int -> ReadS VertexIdType
Read, Int -> VertexIdType -> ShowS
[VertexIdType] -> ShowS
VertexIdType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexIdType] -> ShowS
$cshowList :: [VertexIdType] -> ShowS
show :: VertexIdType -> String
$cshow :: VertexIdType -> String
showsPrec :: Int -> VertexIdType -> ShowS
$cshowsPrec :: Int -> VertexIdType -> ShowS
Show)
_VertexIdType :: Name
_VertexIdType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.VertexIdType")
data VertexType =
VertexType {
VertexType -> LiteralType
vertexTypeId :: Core.LiteralType,
VertexType -> Map Key Type
vertexTypeProperties :: (Map Key Type)}
deriving (VertexType -> VertexType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexType -> VertexType -> Bool
$c/= :: VertexType -> VertexType -> Bool
== :: VertexType -> VertexType -> Bool
$c== :: VertexType -> VertexType -> Bool
Eq, Eq VertexType
VertexType -> VertexType -> Bool
VertexType -> VertexType -> Ordering
VertexType -> VertexType -> VertexType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexType -> VertexType -> VertexType
$cmin :: VertexType -> VertexType -> VertexType
max :: VertexType -> VertexType -> VertexType
$cmax :: VertexType -> VertexType -> VertexType
>= :: VertexType -> VertexType -> Bool
$c>= :: VertexType -> VertexType -> Bool
> :: VertexType -> VertexType -> Bool
$c> :: VertexType -> VertexType -> Bool
<= :: VertexType -> VertexType -> Bool
$c<= :: VertexType -> VertexType -> Bool
< :: VertexType -> VertexType -> Bool
$c< :: VertexType -> VertexType -> Bool
compare :: VertexType -> VertexType -> Ordering
$ccompare :: VertexType -> VertexType -> Ordering
Ord, ReadPrec [VertexType]
ReadPrec VertexType
Int -> ReadS VertexType
ReadS [VertexType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VertexType]
$creadListPrec :: ReadPrec [VertexType]
readPrec :: ReadPrec VertexType
$creadPrec :: ReadPrec VertexType
readList :: ReadS [VertexType]
$creadList :: ReadS [VertexType]
readsPrec :: Int -> ReadS VertexType
$creadsPrec :: Int -> ReadS VertexType
Read, Int -> VertexType -> ShowS
[VertexType] -> ShowS
VertexType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexType] -> ShowS
$cshowList :: [VertexType] -> ShowS
show :: VertexType -> String
$cshow :: VertexType -> String
showsPrec :: Int -> VertexType -> ShowS
$cshowsPrec :: Int -> VertexType -> ShowS
Show)
_VertexType :: Name
_VertexType = (String -> Name
Core.Name String
"hydra/ext/tinkerpop/typed.VertexType")
_VertexType_id :: FieldName
_VertexType_id = (String -> FieldName
Core.FieldName String
"id")
_VertexType_properties :: FieldName
_VertexType_properties = (String -> FieldName
Core.FieldName String
"properties")