-- | A model for language-agnostic graph pattern queries

module Hydra.Query where

import qualified Hydra.Core as Core
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | One of several comparison operators
data ComparisonConstraint = 
  ComparisonConstraintEqual  |
  ComparisonConstraintNotEqual  |
  ComparisonConstraintLessThan  |
  ComparisonConstraintGreaterThan  |
  ComparisonConstraintLessThanOrEqual  |
  ComparisonConstraintGreaterThanOrEqual 
  deriving (ComparisonConstraint -> ComparisonConstraint -> Bool
(ComparisonConstraint -> ComparisonConstraint -> Bool)
-> (ComparisonConstraint -> ComparisonConstraint -> Bool)
-> Eq ComparisonConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComparisonConstraint -> ComparisonConstraint -> Bool
== :: ComparisonConstraint -> ComparisonConstraint -> Bool
$c/= :: ComparisonConstraint -> ComparisonConstraint -> Bool
/= :: ComparisonConstraint -> ComparisonConstraint -> Bool
Eq, Eq ComparisonConstraint
Eq ComparisonConstraint =>
(ComparisonConstraint -> ComparisonConstraint -> Ordering)
-> (ComparisonConstraint -> ComparisonConstraint -> Bool)
-> (ComparisonConstraint -> ComparisonConstraint -> Bool)
-> (ComparisonConstraint -> ComparisonConstraint -> Bool)
-> (ComparisonConstraint -> ComparisonConstraint -> Bool)
-> (ComparisonConstraint
    -> ComparisonConstraint -> ComparisonConstraint)
-> (ComparisonConstraint
    -> ComparisonConstraint -> ComparisonConstraint)
-> Ord ComparisonConstraint
ComparisonConstraint -> ComparisonConstraint -> Bool
ComparisonConstraint -> ComparisonConstraint -> Ordering
ComparisonConstraint
-> ComparisonConstraint -> ComparisonConstraint
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
$ccompare :: ComparisonConstraint -> ComparisonConstraint -> Ordering
compare :: ComparisonConstraint -> ComparisonConstraint -> Ordering
$c< :: ComparisonConstraint -> ComparisonConstraint -> Bool
< :: ComparisonConstraint -> ComparisonConstraint -> Bool
$c<= :: ComparisonConstraint -> ComparisonConstraint -> Bool
<= :: ComparisonConstraint -> ComparisonConstraint -> Bool
$c> :: ComparisonConstraint -> ComparisonConstraint -> Bool
> :: ComparisonConstraint -> ComparisonConstraint -> Bool
$c>= :: ComparisonConstraint -> ComparisonConstraint -> Bool
>= :: ComparisonConstraint -> ComparisonConstraint -> Bool
$cmax :: ComparisonConstraint
-> ComparisonConstraint -> ComparisonConstraint
max :: ComparisonConstraint
-> ComparisonConstraint -> ComparisonConstraint
$cmin :: ComparisonConstraint
-> ComparisonConstraint -> ComparisonConstraint
min :: ComparisonConstraint
-> ComparisonConstraint -> ComparisonConstraint
Ord, ReadPrec [ComparisonConstraint]
ReadPrec ComparisonConstraint
Int -> ReadS ComparisonConstraint
ReadS [ComparisonConstraint]
(Int -> ReadS ComparisonConstraint)
-> ReadS [ComparisonConstraint]
-> ReadPrec ComparisonConstraint
-> ReadPrec [ComparisonConstraint]
-> Read ComparisonConstraint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ComparisonConstraint
readsPrec :: Int -> ReadS ComparisonConstraint
$creadList :: ReadS [ComparisonConstraint]
readList :: ReadS [ComparisonConstraint]
$creadPrec :: ReadPrec ComparisonConstraint
readPrec :: ReadPrec ComparisonConstraint
$creadListPrec :: ReadPrec [ComparisonConstraint]
readListPrec :: ReadPrec [ComparisonConstraint]
Read, Int -> ComparisonConstraint -> ShowS
[ComparisonConstraint] -> ShowS
ComparisonConstraint -> String
(Int -> ComparisonConstraint -> ShowS)
-> (ComparisonConstraint -> String)
-> ([ComparisonConstraint] -> ShowS)
-> Show ComparisonConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComparisonConstraint -> ShowS
showsPrec :: Int -> ComparisonConstraint -> ShowS
$cshow :: ComparisonConstraint -> String
show :: ComparisonConstraint -> String
$cshowList :: [ComparisonConstraint] -> ShowS
showList :: [ComparisonConstraint] -> ShowS
Show)

_ComparisonConstraint :: Name
_ComparisonConstraint = (String -> Name
Core.Name String
"hydra/query.ComparisonConstraint")

_ComparisonConstraint_equal :: Name
_ComparisonConstraint_equal = (String -> Name
Core.Name String
"equal")

_ComparisonConstraint_notEqual :: Name
_ComparisonConstraint_notEqual = (String -> Name
Core.Name String
"notEqual")

_ComparisonConstraint_lessThan :: Name
_ComparisonConstraint_lessThan = (String -> Name
Core.Name String
"lessThan")

_ComparisonConstraint_greaterThan :: Name
_ComparisonConstraint_greaterThan = (String -> Name
Core.Name String
"greaterThan")

_ComparisonConstraint_lessThanOrEqual :: Name
_ComparisonConstraint_lessThanOrEqual = (String -> Name
Core.Name String
"lessThanOrEqual")

_ComparisonConstraint_greaterThanOrEqual :: Name
_ComparisonConstraint_greaterThanOrEqual = (String -> Name
Core.Name String
"greaterThanOrEqual")

-- | An abstract edge based on a record type
data Edge = 
  Edge {
    -- | The name of a record type, for which the edge also specifies an out- and an in- projection
    Edge -> Name
edgeType :: Core.Name,
    -- | The field representing the out-projection of the edge. Defaults to 'out'.
    Edge -> Maybe Name
edgeOut :: (Maybe Core.Name),
    -- | The field representing the in-projection of the edge. Defaults to 'in'.
    Edge -> Maybe Name
edgeIn :: (Maybe Core.Name)}
  deriving (Edge -> Edge -> Bool
(Edge -> Edge -> Bool) -> (Edge -> Edge -> Bool) -> Eq Edge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
/= :: Edge -> Edge -> Bool
Eq, Eq Edge
Eq Edge =>
(Edge -> Edge -> Ordering)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Edge)
-> (Edge -> Edge -> Edge)
-> Ord 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
$ccompare :: Edge -> Edge -> Ordering
compare :: Edge -> Edge -> Ordering
$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
>= :: Edge -> Edge -> Bool
$cmax :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
min :: Edge -> Edge -> Edge
Ord, ReadPrec [Edge]
ReadPrec Edge
Int -> ReadS Edge
ReadS [Edge]
(Int -> ReadS Edge)
-> ReadS [Edge] -> ReadPrec Edge -> ReadPrec [Edge] -> Read Edge
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Edge
readsPrec :: Int -> ReadS Edge
$creadList :: ReadS [Edge]
readList :: ReadS [Edge]
$creadPrec :: ReadPrec Edge
readPrec :: ReadPrec Edge
$creadListPrec :: ReadPrec [Edge]
readListPrec :: ReadPrec [Edge]
Read, Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
(Int -> Edge -> ShowS)
-> (Edge -> String) -> ([Edge] -> ShowS) -> Show Edge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Edge -> ShowS
showsPrec :: Int -> Edge -> ShowS
$cshow :: Edge -> String
show :: Edge -> String
$cshowList :: [Edge] -> ShowS
showList :: [Edge] -> ShowS
Show)

_Edge :: Name
_Edge = (String -> Name
Core.Name String
"hydra/query.Edge")

_Edge_type :: Name
_Edge_type = (String -> Name
Core.Name String
"type")

_Edge_out :: Name
_Edge_out = (String -> Name
Core.Name String
"out")

_Edge_in :: Name
_Edge_in = (String -> Name
Core.Name String
"in")

-- | A query pattern which matches within a designated component subgraph
data GraphPattern = 
  GraphPattern {
    -- | The name of the component graph
    GraphPattern -> Name
graphPatternGraph :: Core.Name,
    -- | The patterns to match within the subgraph
    GraphPattern -> [Pattern]
graphPatternPatterns :: [Pattern]}
  deriving (GraphPattern -> GraphPattern -> Bool
(GraphPattern -> GraphPattern -> Bool)
-> (GraphPattern -> GraphPattern -> Bool) -> Eq GraphPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphPattern -> GraphPattern -> Bool
== :: GraphPattern -> GraphPattern -> Bool
$c/= :: GraphPattern -> GraphPattern -> Bool
/= :: GraphPattern -> GraphPattern -> Bool
Eq, Eq GraphPattern
Eq GraphPattern =>
(GraphPattern -> GraphPattern -> Ordering)
-> (GraphPattern -> GraphPattern -> Bool)
-> (GraphPattern -> GraphPattern -> Bool)
-> (GraphPattern -> GraphPattern -> Bool)
-> (GraphPattern -> GraphPattern -> Bool)
-> (GraphPattern -> GraphPattern -> GraphPattern)
-> (GraphPattern -> GraphPattern -> GraphPattern)
-> Ord GraphPattern
GraphPattern -> GraphPattern -> Bool
GraphPattern -> GraphPattern -> Ordering
GraphPattern -> GraphPattern -> GraphPattern
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
$ccompare :: GraphPattern -> GraphPattern -> Ordering
compare :: GraphPattern -> GraphPattern -> Ordering
$c< :: GraphPattern -> GraphPattern -> Bool
< :: GraphPattern -> GraphPattern -> Bool
$c<= :: GraphPattern -> GraphPattern -> Bool
<= :: GraphPattern -> GraphPattern -> Bool
$c> :: GraphPattern -> GraphPattern -> Bool
> :: GraphPattern -> GraphPattern -> Bool
$c>= :: GraphPattern -> GraphPattern -> Bool
>= :: GraphPattern -> GraphPattern -> Bool
$cmax :: GraphPattern -> GraphPattern -> GraphPattern
max :: GraphPattern -> GraphPattern -> GraphPattern
$cmin :: GraphPattern -> GraphPattern -> GraphPattern
min :: GraphPattern -> GraphPattern -> GraphPattern
Ord, ReadPrec [GraphPattern]
ReadPrec GraphPattern
Int -> ReadS GraphPattern
ReadS [GraphPattern]
(Int -> ReadS GraphPattern)
-> ReadS [GraphPattern]
-> ReadPrec GraphPattern
-> ReadPrec [GraphPattern]
-> Read GraphPattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GraphPattern
readsPrec :: Int -> ReadS GraphPattern
$creadList :: ReadS [GraphPattern]
readList :: ReadS [GraphPattern]
$creadPrec :: ReadPrec GraphPattern
readPrec :: ReadPrec GraphPattern
$creadListPrec :: ReadPrec [GraphPattern]
readListPrec :: ReadPrec [GraphPattern]
Read, Int -> GraphPattern -> ShowS
[GraphPattern] -> ShowS
GraphPattern -> String
(Int -> GraphPattern -> ShowS)
-> (GraphPattern -> String)
-> ([GraphPattern] -> ShowS)
-> Show GraphPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphPattern -> ShowS
showsPrec :: Int -> GraphPattern -> ShowS
$cshow :: GraphPattern -> String
show :: GraphPattern -> String
$cshowList :: [GraphPattern] -> ShowS
showList :: [GraphPattern] -> ShowS
Show)

_GraphPattern :: Name
_GraphPattern = (String -> Name
Core.Name String
"hydra/query.GraphPattern")

_GraphPattern_graph :: Name
_GraphPattern_graph = (String -> Name
Core.Name String
"graph")

_GraphPattern_patterns :: Name
_GraphPattern_patterns = (String -> Name
Core.Name String
"patterns")

-- | A node in a query expression; it may be a term, a variable, or a wildcard
data Node = 
  -- | A graph term; an expression which is valid in the graph being matched
  NodeTerm Core.Term |
  -- | A query variable, not to be confused with a variable term
  NodeVariable Variable |
  -- | An anonymous variable which we do not care to join across patterns
  NodeWildcard 
  deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, Eq Node
Eq Node =>
(Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
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
$ccompare :: Node -> Node -> Ordering
compare :: Node -> Node -> Ordering
$c< :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
>= :: Node -> Node -> Bool
$cmax :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
min :: Node -> Node -> Node
Ord, ReadPrec [Node]
ReadPrec Node
Int -> ReadS Node
ReadS [Node]
(Int -> ReadS Node)
-> ReadS [Node] -> ReadPrec Node -> ReadPrec [Node] -> Read Node
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Node
readsPrec :: Int -> ReadS Node
$creadList :: ReadS [Node]
readList :: ReadS [Node]
$creadPrec :: ReadPrec Node
readPrec :: ReadPrec Node
$creadListPrec :: ReadPrec [Node]
readListPrec :: ReadPrec [Node]
Read, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show)

_Node :: Name
_Node = (String -> Name
Core.Name String
"hydra/query.Node")

_Node_term :: Name
_Node_term = (String -> Name
Core.Name String
"term")

_Node_variable :: Name
_Node_variable = (String -> Name
Core.Name String
"variable")

_Node_wildcard :: Name
_Node_wildcard = (String -> Name
Core.Name String
"wildcard")

-- | A query path
data Path = 
  -- | A path given by a single step
  PathStep Step |
  -- | A path given by a regular expression quantifier applied to another path
  PathRegex RegexSequence |
  -- | A path given by the inverse of another path
  PathInverse Path
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord, ReadPrec [Path]
ReadPrec Path
Int -> ReadS Path
ReadS [Path]
(Int -> ReadS Path)
-> ReadS [Path] -> ReadPrec Path -> ReadPrec [Path] -> Read Path
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Path
readsPrec :: Int -> ReadS Path
$creadList :: ReadS [Path]
readList :: ReadS [Path]
$creadPrec :: ReadPrec Path
readPrec :: ReadPrec Path
$creadListPrec :: ReadPrec [Path]
readListPrec :: ReadPrec [Path]
Read, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)

_Path :: Name
_Path = (String -> Name
Core.Name String
"hydra/query.Path")

_Path_step :: Name
_Path_step = (String -> Name
Core.Name String
"step")

_Path_regex :: Name
_Path_regex = (String -> Name
Core.Name String
"regex")

_Path_inverse :: Name
_Path_inverse = (String -> Name
Core.Name String
"inverse")

-- | A query pattern
data Pattern = 
  -- | A subject/predicate/object pattern
  PatternTriple TriplePattern |
  -- | The negation of another pattern
  PatternNegation Pattern |
  -- | The conjunction ('and') of several other patterns
  PatternConjunction [Pattern] |
  -- | The disjunction (inclusive 'or') of several other patterns
  PatternDisjunction [Pattern] |
  -- | A pattern which matches within a named subgraph
  PatternGraph GraphPattern
  deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
/= :: Pattern -> Pattern -> Bool
Eq, Eq Pattern
Eq Pattern =>
(Pattern -> Pattern -> Ordering)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Pattern)
-> (Pattern -> Pattern -> Pattern)
-> Ord Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
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
$ccompare :: Pattern -> Pattern -> Ordering
compare :: Pattern -> Pattern -> Ordering
$c< :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
>= :: Pattern -> Pattern -> Bool
$cmax :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
min :: Pattern -> Pattern -> Pattern
Ord, ReadPrec [Pattern]
ReadPrec Pattern
Int -> ReadS Pattern
ReadS [Pattern]
(Int -> ReadS Pattern)
-> ReadS [Pattern]
-> ReadPrec Pattern
-> ReadPrec [Pattern]
-> Read Pattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pattern
readsPrec :: Int -> ReadS Pattern
$creadList :: ReadS [Pattern]
readList :: ReadS [Pattern]
$creadPrec :: ReadPrec Pattern
readPrec :: ReadPrec Pattern
$creadListPrec :: ReadPrec [Pattern]
readListPrec :: ReadPrec [Pattern]
Read, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> String
show :: Pattern -> String
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
Show)

_Pattern :: Name
_Pattern = (String -> Name
Core.Name String
"hydra/query.Pattern")

_Pattern_triple :: Name
_Pattern_triple = (String -> Name
Core.Name String
"triple")

_Pattern_negation :: Name
_Pattern_negation = (String -> Name
Core.Name String
"negation")

_Pattern_conjunction :: Name
_Pattern_conjunction = (String -> Name
Core.Name String
"conjunction")

_Pattern_disjunction :: Name
_Pattern_disjunction = (String -> Name
Core.Name String
"disjunction")

_Pattern_graph :: Name
_Pattern_graph = (String -> Name
Core.Name String
"graph")

-- | A SELECT-style graph pattern matching query
data Query = 
  Query {
    -- | The variables selected by the query
    Query -> [Variable]
queryVariables :: [Variable],
    -- | The patterns to be matched
    Query -> [Pattern]
queryPatterns :: [Pattern]}
  deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, Eq Query
Eq Query =>
(Query -> Query -> Ordering)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Query)
-> (Query -> Query -> Query)
-> Ord Query
Query -> Query -> Bool
Query -> Query -> Ordering
Query -> Query -> Query
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
$ccompare :: Query -> Query -> Ordering
compare :: Query -> Query -> Ordering
$c< :: Query -> Query -> Bool
< :: Query -> Query -> Bool
$c<= :: Query -> Query -> Bool
<= :: Query -> Query -> Bool
$c> :: Query -> Query -> Bool
> :: Query -> Query -> Bool
$c>= :: Query -> Query -> Bool
>= :: Query -> Query -> Bool
$cmax :: Query -> Query -> Query
max :: Query -> Query -> Query
$cmin :: Query -> Query -> Query
min :: Query -> Query -> Query
Ord, ReadPrec [Query]
ReadPrec Query
Int -> ReadS Query
ReadS [Query]
(Int -> ReadS Query)
-> ReadS [Query]
-> ReadPrec Query
-> ReadPrec [Query]
-> Read Query
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Query
readsPrec :: Int -> ReadS Query
$creadList :: ReadS [Query]
readList :: ReadS [Query]
$creadPrec :: ReadPrec Query
readPrec :: ReadPrec Query
$creadListPrec :: ReadPrec [Query]
readListPrec :: ReadPrec [Query]
Read, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> String
show :: Query -> String
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show)

_Query :: Name
_Query = (String -> Name
Core.Name String
"hydra/query.Query")

_Query_variables :: Name
_Query_variables = (String -> Name
Core.Name String
"variables")

_Query_patterns :: Name
_Query_patterns = (String -> Name
Core.Name String
"patterns")

-- | A range from min to max, inclusive
data Range = 
  Range {
    Range -> Int
rangeMin :: Int,
    Range -> Int
rangeMax :: Int}
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
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
$ccompare :: Range -> Range -> Ordering
compare :: Range -> Range -> Ordering
$c< :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
>= :: Range -> Range -> Bool
$cmax :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
min :: Range -> Range -> Range
Ord, ReadPrec [Range]
ReadPrec Range
Int -> ReadS Range
ReadS [Range]
(Int -> ReadS Range)
-> ReadS [Range]
-> ReadPrec Range
-> ReadPrec [Range]
-> Read Range
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Range
readsPrec :: Int -> ReadS Range
$creadList :: ReadS [Range]
readList :: ReadS [Range]
$creadPrec :: ReadPrec Range
readPrec :: ReadPrec Range
$creadListPrec :: ReadPrec [Range]
readListPrec :: ReadPrec [Range]
Read, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show)

_Range :: Name
_Range = (String -> Name
Core.Name String
"hydra/query.Range")

_Range_min :: Name
_Range_min = (String -> Name
Core.Name String
"min")

_Range_max :: Name
_Range_max = (String -> Name
Core.Name String
"max")

-- | A regular expression quantifier
data RegexQuantifier = 
  -- | No quantifier; matches a single occurrence
  RegexQuantifierOne  |
  -- | The ? quanifier; matches zero or one occurrence
  RegexQuantifierZeroOrOne  |
  -- | The * quantifier; matches any number of occurrences
  RegexQuantifierZeroOrMore  |
  -- | The + quantifier; matches one or more occurrences
  RegexQuantifierOneOrMore  |
  -- | The {n} quantifier; matches exactly n occurrences
  RegexQuantifierExactly Int |
  -- | The {n,} quantifier; matches at least n occurrences
  RegexQuantifierAtLeast Int |
  -- | The {n, m} quantifier; matches between n and m (inclusive) occurrences
  RegexQuantifierRange Range
  deriving (RegexQuantifier -> RegexQuantifier -> Bool
(RegexQuantifier -> RegexQuantifier -> Bool)
-> (RegexQuantifier -> RegexQuantifier -> Bool)
-> Eq RegexQuantifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegexQuantifier -> RegexQuantifier -> Bool
== :: RegexQuantifier -> RegexQuantifier -> Bool
$c/= :: RegexQuantifier -> RegexQuantifier -> Bool
/= :: RegexQuantifier -> RegexQuantifier -> Bool
Eq, Eq RegexQuantifier
Eq RegexQuantifier =>
(RegexQuantifier -> RegexQuantifier -> Ordering)
-> (RegexQuantifier -> RegexQuantifier -> Bool)
-> (RegexQuantifier -> RegexQuantifier -> Bool)
-> (RegexQuantifier -> RegexQuantifier -> Bool)
-> (RegexQuantifier -> RegexQuantifier -> Bool)
-> (RegexQuantifier -> RegexQuantifier -> RegexQuantifier)
-> (RegexQuantifier -> RegexQuantifier -> RegexQuantifier)
-> Ord RegexQuantifier
RegexQuantifier -> RegexQuantifier -> Bool
RegexQuantifier -> RegexQuantifier -> Ordering
RegexQuantifier -> RegexQuantifier -> RegexQuantifier
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
$ccompare :: RegexQuantifier -> RegexQuantifier -> Ordering
compare :: RegexQuantifier -> RegexQuantifier -> Ordering
$c< :: RegexQuantifier -> RegexQuantifier -> Bool
< :: RegexQuantifier -> RegexQuantifier -> Bool
$c<= :: RegexQuantifier -> RegexQuantifier -> Bool
<= :: RegexQuantifier -> RegexQuantifier -> Bool
$c> :: RegexQuantifier -> RegexQuantifier -> Bool
> :: RegexQuantifier -> RegexQuantifier -> Bool
$c>= :: RegexQuantifier -> RegexQuantifier -> Bool
>= :: RegexQuantifier -> RegexQuantifier -> Bool
$cmax :: RegexQuantifier -> RegexQuantifier -> RegexQuantifier
max :: RegexQuantifier -> RegexQuantifier -> RegexQuantifier
$cmin :: RegexQuantifier -> RegexQuantifier -> RegexQuantifier
min :: RegexQuantifier -> RegexQuantifier -> RegexQuantifier
Ord, ReadPrec [RegexQuantifier]
ReadPrec RegexQuantifier
Int -> ReadS RegexQuantifier
ReadS [RegexQuantifier]
(Int -> ReadS RegexQuantifier)
-> ReadS [RegexQuantifier]
-> ReadPrec RegexQuantifier
-> ReadPrec [RegexQuantifier]
-> Read RegexQuantifier
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegexQuantifier
readsPrec :: Int -> ReadS RegexQuantifier
$creadList :: ReadS [RegexQuantifier]
readList :: ReadS [RegexQuantifier]
$creadPrec :: ReadPrec RegexQuantifier
readPrec :: ReadPrec RegexQuantifier
$creadListPrec :: ReadPrec [RegexQuantifier]
readListPrec :: ReadPrec [RegexQuantifier]
Read, Int -> RegexQuantifier -> ShowS
[RegexQuantifier] -> ShowS
RegexQuantifier -> String
(Int -> RegexQuantifier -> ShowS)
-> (RegexQuantifier -> String)
-> ([RegexQuantifier] -> ShowS)
-> Show RegexQuantifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegexQuantifier -> ShowS
showsPrec :: Int -> RegexQuantifier -> ShowS
$cshow :: RegexQuantifier -> String
show :: RegexQuantifier -> String
$cshowList :: [RegexQuantifier] -> ShowS
showList :: [RegexQuantifier] -> ShowS
Show)

_RegexQuantifier :: Name
_RegexQuantifier = (String -> Name
Core.Name String
"hydra/query.RegexQuantifier")

_RegexQuantifier_one :: Name
_RegexQuantifier_one = (String -> Name
Core.Name String
"one")

_RegexQuantifier_zeroOrOne :: Name
_RegexQuantifier_zeroOrOne = (String -> Name
Core.Name String
"zeroOrOne")

_RegexQuantifier_zeroOrMore :: Name
_RegexQuantifier_zeroOrMore = (String -> Name
Core.Name String
"zeroOrMore")

_RegexQuantifier_oneOrMore :: Name
_RegexQuantifier_oneOrMore = (String -> Name
Core.Name String
"oneOrMore")

_RegexQuantifier_exactly :: Name
_RegexQuantifier_exactly = (String -> Name
Core.Name String
"exactly")

_RegexQuantifier_atLeast :: Name
_RegexQuantifier_atLeast = (String -> Name
Core.Name String
"atLeast")

_RegexQuantifier_range :: Name
_RegexQuantifier_range = (String -> Name
Core.Name String
"range")

-- | A path with a regex quantifier
data RegexSequence = 
  RegexSequence {
    RegexSequence -> Path
regexSequencePath :: Path,
    RegexSequence -> RegexQuantifier
regexSequenceQuantifier :: RegexQuantifier}
  deriving (RegexSequence -> RegexSequence -> Bool
(RegexSequence -> RegexSequence -> Bool)
-> (RegexSequence -> RegexSequence -> Bool) -> Eq RegexSequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegexSequence -> RegexSequence -> Bool
== :: RegexSequence -> RegexSequence -> Bool
$c/= :: RegexSequence -> RegexSequence -> Bool
/= :: RegexSequence -> RegexSequence -> Bool
Eq, Eq RegexSequence
Eq RegexSequence =>
(RegexSequence -> RegexSequence -> Ordering)
-> (RegexSequence -> RegexSequence -> Bool)
-> (RegexSequence -> RegexSequence -> Bool)
-> (RegexSequence -> RegexSequence -> Bool)
-> (RegexSequence -> RegexSequence -> Bool)
-> (RegexSequence -> RegexSequence -> RegexSequence)
-> (RegexSequence -> RegexSequence -> RegexSequence)
-> Ord RegexSequence
RegexSequence -> RegexSequence -> Bool
RegexSequence -> RegexSequence -> Ordering
RegexSequence -> RegexSequence -> RegexSequence
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
$ccompare :: RegexSequence -> RegexSequence -> Ordering
compare :: RegexSequence -> RegexSequence -> Ordering
$c< :: RegexSequence -> RegexSequence -> Bool
< :: RegexSequence -> RegexSequence -> Bool
$c<= :: RegexSequence -> RegexSequence -> Bool
<= :: RegexSequence -> RegexSequence -> Bool
$c> :: RegexSequence -> RegexSequence -> Bool
> :: RegexSequence -> RegexSequence -> Bool
$c>= :: RegexSequence -> RegexSequence -> Bool
>= :: RegexSequence -> RegexSequence -> Bool
$cmax :: RegexSequence -> RegexSequence -> RegexSequence
max :: RegexSequence -> RegexSequence -> RegexSequence
$cmin :: RegexSequence -> RegexSequence -> RegexSequence
min :: RegexSequence -> RegexSequence -> RegexSequence
Ord, ReadPrec [RegexSequence]
ReadPrec RegexSequence
Int -> ReadS RegexSequence
ReadS [RegexSequence]
(Int -> ReadS RegexSequence)
-> ReadS [RegexSequence]
-> ReadPrec RegexSequence
-> ReadPrec [RegexSequence]
-> Read RegexSequence
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegexSequence
readsPrec :: Int -> ReadS RegexSequence
$creadList :: ReadS [RegexSequence]
readList :: ReadS [RegexSequence]
$creadPrec :: ReadPrec RegexSequence
readPrec :: ReadPrec RegexSequence
$creadListPrec :: ReadPrec [RegexSequence]
readListPrec :: ReadPrec [RegexSequence]
Read, Int -> RegexSequence -> ShowS
[RegexSequence] -> ShowS
RegexSequence -> String
(Int -> RegexSequence -> ShowS)
-> (RegexSequence -> String)
-> ([RegexSequence] -> ShowS)
-> Show RegexSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegexSequence -> ShowS
showsPrec :: Int -> RegexSequence -> ShowS
$cshow :: RegexSequence -> String
show :: RegexSequence -> String
$cshowList :: [RegexSequence] -> ShowS
showList :: [RegexSequence] -> ShowS
Show)

_RegexSequence :: Name
_RegexSequence = (String -> Name
Core.Name String
"hydra/query.RegexSequence")

_RegexSequence_path :: Name
_RegexSequence_path = (String -> Name
Core.Name String
"path")

_RegexSequence_quantifier :: Name
_RegexSequence_quantifier = (String -> Name
Core.Name String
"quantifier")

-- | An atomic function as part of a query. When applied to a graph, steps are typed by function types.
data Step = 
  -- | An out-to-in traversal of an abstract edge
  StepEdge Edge |
  -- | A projection from a record through one of its fields
  StepProject Core.Projection |
  -- | A comparison of two terms
  StepCompare ComparisonConstraint
  deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
/= :: Step -> Step -> Bool
Eq, Eq Step
Eq Step =>
(Step -> Step -> Ordering)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Step)
-> (Step -> Step -> Step)
-> Ord Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
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
$ccompare :: Step -> Step -> Ordering
compare :: Step -> Step -> Ordering
$c< :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
>= :: Step -> Step -> Bool
$cmax :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
min :: Step -> Step -> Step
Ord, ReadPrec [Step]
ReadPrec Step
Int -> ReadS Step
ReadS [Step]
(Int -> ReadS Step)
-> ReadS [Step] -> ReadPrec Step -> ReadPrec [Step] -> Read Step
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Step
readsPrec :: Int -> ReadS Step
$creadList :: ReadS [Step]
readList :: ReadS [Step]
$creadPrec :: ReadPrec Step
readPrec :: ReadPrec Step
$creadListPrec :: ReadPrec [Step]
readListPrec :: ReadPrec [Step]
Read, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Step -> ShowS
showsPrec :: Int -> Step -> ShowS
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> ShowS
showList :: [Step] -> ShowS
Show)

_Step :: Name
_Step = (String -> Name
Core.Name String
"hydra/query.Step")

_Step_edge :: Name
_Step_edge = (String -> Name
Core.Name String
"edge")

_Step_project :: Name
_Step_project = (String -> Name
Core.Name String
"project")

_Step_compare :: Name
_Step_compare = (String -> Name
Core.Name String
"compare")

-- | A subject/predicate/object pattern
data TriplePattern = 
  TriplePattern {
    TriplePattern -> Node
triplePatternSubject :: Node,
    TriplePattern -> Path
triplePatternPredicate :: Path,
    TriplePattern -> Node
triplePatternObject :: Node}
  deriving (TriplePattern -> TriplePattern -> Bool
(TriplePattern -> TriplePattern -> Bool)
-> (TriplePattern -> TriplePattern -> Bool) -> Eq TriplePattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TriplePattern -> TriplePattern -> Bool
== :: TriplePattern -> TriplePattern -> Bool
$c/= :: TriplePattern -> TriplePattern -> Bool
/= :: TriplePattern -> TriplePattern -> Bool
Eq, Eq TriplePattern
Eq TriplePattern =>
(TriplePattern -> TriplePattern -> Ordering)
-> (TriplePattern -> TriplePattern -> Bool)
-> (TriplePattern -> TriplePattern -> Bool)
-> (TriplePattern -> TriplePattern -> Bool)
-> (TriplePattern -> TriplePattern -> Bool)
-> (TriplePattern -> TriplePattern -> TriplePattern)
-> (TriplePattern -> TriplePattern -> TriplePattern)
-> Ord TriplePattern
TriplePattern -> TriplePattern -> Bool
TriplePattern -> TriplePattern -> Ordering
TriplePattern -> TriplePattern -> TriplePattern
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
$ccompare :: TriplePattern -> TriplePattern -> Ordering
compare :: TriplePattern -> TriplePattern -> Ordering
$c< :: TriplePattern -> TriplePattern -> Bool
< :: TriplePattern -> TriplePattern -> Bool
$c<= :: TriplePattern -> TriplePattern -> Bool
<= :: TriplePattern -> TriplePattern -> Bool
$c> :: TriplePattern -> TriplePattern -> Bool
> :: TriplePattern -> TriplePattern -> Bool
$c>= :: TriplePattern -> TriplePattern -> Bool
>= :: TriplePattern -> TriplePattern -> Bool
$cmax :: TriplePattern -> TriplePattern -> TriplePattern
max :: TriplePattern -> TriplePattern -> TriplePattern
$cmin :: TriplePattern -> TriplePattern -> TriplePattern
min :: TriplePattern -> TriplePattern -> TriplePattern
Ord, ReadPrec [TriplePattern]
ReadPrec TriplePattern
Int -> ReadS TriplePattern
ReadS [TriplePattern]
(Int -> ReadS TriplePattern)
-> ReadS [TriplePattern]
-> ReadPrec TriplePattern
-> ReadPrec [TriplePattern]
-> Read TriplePattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TriplePattern
readsPrec :: Int -> ReadS TriplePattern
$creadList :: ReadS [TriplePattern]
readList :: ReadS [TriplePattern]
$creadPrec :: ReadPrec TriplePattern
readPrec :: ReadPrec TriplePattern
$creadListPrec :: ReadPrec [TriplePattern]
readListPrec :: ReadPrec [TriplePattern]
Read, Int -> TriplePattern -> ShowS
[TriplePattern] -> ShowS
TriplePattern -> String
(Int -> TriplePattern -> ShowS)
-> (TriplePattern -> String)
-> ([TriplePattern] -> ShowS)
-> Show TriplePattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TriplePattern -> ShowS
showsPrec :: Int -> TriplePattern -> ShowS
$cshow :: TriplePattern -> String
show :: TriplePattern -> String
$cshowList :: [TriplePattern] -> ShowS
showList :: [TriplePattern] -> ShowS
Show)

_TriplePattern :: Name
_TriplePattern = (String -> Name
Core.Name String
"hydra/query.TriplePattern")

_TriplePattern_subject :: Name
_TriplePattern_subject = (String -> Name
Core.Name String
"subject")

_TriplePattern_predicate :: Name
_TriplePattern_predicate = (String -> Name
Core.Name String
"predicate")

_TriplePattern_object :: Name
_TriplePattern_object = (String -> Name
Core.Name String
"object")

-- | A query variable
newtype Variable = 
  Variable {
    Variable -> String
unVariable :: String}
  deriving (Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
/= :: Variable -> Variable -> Bool
Eq, Eq Variable
Eq Variable =>
(Variable -> Variable -> Ordering)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Variable)
-> (Variable -> Variable -> Variable)
-> Ord Variable
Variable -> Variable -> Bool
Variable -> Variable -> Ordering
Variable -> Variable -> Variable
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
$ccompare :: Variable -> Variable -> Ordering
compare :: Variable -> Variable -> Ordering
$c< :: Variable -> Variable -> Bool
< :: Variable -> Variable -> Bool
$c<= :: Variable -> Variable -> Bool
<= :: Variable -> Variable -> Bool
$c> :: Variable -> Variable -> Bool
> :: Variable -> Variable -> Bool
$c>= :: Variable -> Variable -> Bool
>= :: Variable -> Variable -> Bool
$cmax :: Variable -> Variable -> Variable
max :: Variable -> Variable -> Variable
$cmin :: Variable -> Variable -> Variable
min :: Variable -> Variable -> Variable
Ord, ReadPrec [Variable]
ReadPrec Variable
Int -> ReadS Variable
ReadS [Variable]
(Int -> ReadS Variable)
-> ReadS [Variable]
-> ReadPrec Variable
-> ReadPrec [Variable]
-> Read Variable
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Variable
readsPrec :: Int -> ReadS Variable
$creadList :: ReadS [Variable]
readList :: ReadS [Variable]
$creadPrec :: ReadPrec Variable
readPrec :: ReadPrec Variable
$creadListPrec :: ReadPrec [Variable]
readListPrec :: ReadPrec [Variable]
Read, Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Variable -> ShowS
showsPrec :: Int -> Variable -> ShowS
$cshow :: Variable -> String
show :: Variable -> String
$cshowList :: [Variable] -> ShowS
showList :: [Variable] -> ShowS
Show)

_Variable :: Name
_Variable = (String -> Name
Core.Name String
"hydra/query.Variable")