{- |
Module      : Model.ServerObjectTypes
Description : Here is the data types for the server objects.
License     : IPS
Maintainer  : jasonsychau@live.ca
Stability   : provisional
-}
module Model.ServerObjectTypes where


-- | These are objects to represent GraphQL query roots.
type RootObjects = [RootObject]
type RootObject = NestedObject

-- | NestedObjects are the general object type. They are found as RootObjects or as object Subfields.
data NestedObject = NestedObject !Alias !Name !ServerObject !SubSelection !SubFields
                    deriving (Int -> NestedObject -> ShowS
[NestedObject] -> ShowS
NestedObject -> String
(Int -> NestedObject -> ShowS)
-> (NestedObject -> String)
-> ([NestedObject] -> ShowS)
-> Show NestedObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NestedObject] -> ShowS
$cshowList :: [NestedObject] -> ShowS
show :: NestedObject -> String
$cshow :: NestedObject -> String
showsPrec :: Int -> NestedObject -> ShowS
$cshowsPrec :: Int -> NestedObject -> ShowS
Show,NestedObject -> NestedObject -> Bool
(NestedObject -> NestedObject -> Bool)
-> (NestedObject -> NestedObject -> Bool) -> Eq NestedObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NestedObject -> NestedObject -> Bool
$c/= :: NestedObject -> NestedObject -> Bool
== :: NestedObject -> NestedObject -> Bool
$c== :: NestedObject -> NestedObject -> Bool
Eq)
type Alias = Maybe String
type ServerObject = String
type SubSelection = Maybe ScalarType
type SubFields = [Field]
type Field = Either ScalarType FieldObject
type FieldObject = Either NestedObject InlinefragmentObject
data InlinefragmentObject = InlinefragmentObject !ServerObject !SubFields
                    deriving (Int -> InlinefragmentObject -> ShowS
[InlinefragmentObject] -> ShowS
InlinefragmentObject -> String
(Int -> InlinefragmentObject -> ShowS)
-> (InlinefragmentObject -> String)
-> ([InlinefragmentObject] -> ShowS)
-> Show InlinefragmentObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlinefragmentObject] -> ShowS
$cshowList :: [InlinefragmentObject] -> ShowS
show :: InlinefragmentObject -> String
$cshow :: InlinefragmentObject -> String
showsPrec :: Int -> InlinefragmentObject -> ShowS
$cshowsPrec :: Int -> InlinefragmentObject -> ShowS
Show,InlinefragmentObject -> InlinefragmentObject -> Bool
(InlinefragmentObject -> InlinefragmentObject -> Bool)
-> (InlinefragmentObject -> InlinefragmentObject -> Bool)
-> Eq InlinefragmentObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlinefragmentObject -> InlinefragmentObject -> Bool
$c/= :: InlinefragmentObject -> InlinefragmentObject -> Bool
== :: InlinefragmentObject -> InlinefragmentObject -> Bool
$c== :: InlinefragmentObject -> InlinefragmentObject -> Bool
Eq)

-- | ScalarTypes are the other subfield type. They are also found at object attributes.
data ScalarType = ScalarType !Alias !Name !Transformation !Argument
               deriving (Int -> ScalarType -> ShowS
[ScalarType] -> ShowS
ScalarType -> String
(Int -> ScalarType -> ShowS)
-> (ScalarType -> String)
-> ([ScalarType] -> ShowS)
-> Show ScalarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScalarType] -> ShowS
$cshowList :: [ScalarType] -> ShowS
show :: ScalarType -> String
$cshow :: ScalarType -> String
showsPrec :: Int -> ScalarType -> ShowS
$cshowsPrec :: Int -> ScalarType -> ShowS
Show,ScalarType -> ScalarType -> Bool
(ScalarType -> ScalarType -> Bool)
-> (ScalarType -> ScalarType -> Bool) -> Eq ScalarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScalarType -> ScalarType -> Bool
$c/= :: ScalarType -> ScalarType -> Bool
== :: ScalarType -> ScalarType -> Bool
$c== :: ScalarType -> ScalarType -> Bool
Eq)
type Transformation = Maybe String
type Argument = Maybe String

type Name = String

data Fragment = Fragment
    { Fragment -> String
name :: String
    , Fragment -> String
targetObject :: ServerObject
    , Fragment -> String
replacement :: String
    }
data FlagNode = FlagNode Int [FlagNode]

type SchemaSpecs = ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])

type QueryData = [(RootObject,[([(Int,Bool,String)])])]
type AggQueryData = [(RootObject,[[(Int,Int,Bool,String)]])]