{- |
Module      : GraphQLdbi
Description : Here are methods to interpret your GraphQL-to-SQL query and process list-style database results
License     : IPS
Maintainer  : jasonsychau@live.ca
Stability   : provisional

<https://graphql.github.io/ Here> is a link to the official documents. You can learn and get a feel of how can you implement this package which is a GraphQL-to-SQL translator with Persistent package style return-value processing to make a GraphQL format return object string.

This module is made to enable interpreting your GraphQL queries. The expected query type is a single string to comprise all your GraphQL queries and fragments, and the expected variable type is a single string to variable-to-value definitions.

When errors are encountered, module is going to throw an uncaught Exception. The Exception name is a hint to the cause to the error. More information is provided in the below function descriptions.

Not all GraphQL features are currently supported. For a list to updates and current state, you should check the GitHub updates and example <https://github.com/jasonsychau/graphql-w-persistent page>. Since this package is a middleware for your database and your client, you may make an external solution for the other GraphQL features. You may find an example in the before mentioned repo.

-}
module GraphQLdbi (
    -- * Functions
    -- | Here is the methods for the query interpretation, validation, and formatting features.
    module GraphQLdbi,
    -- * Server exceptions
    -- | These are exceptions from the package to make error handling.
    module Model.ServerExceptions
    ) where

import Data.Text (Text)
import Data.Int (Int64)
import Control.Exception (throw)
import Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries)
import Components.Parsers.QueryParser (validateQuery,parseStringToObjects,processString)
import Components.Parsers.ServerSchemaJsonParser (fetchArguments)
import Components.Parsers.VariablesParser (parseVariables)
import Components.ObjectHandlers.ServerObjectInspector (checkObjectsAttributes,replaceObjectsVariables,flagOneWay)
import Components.ObjectHandlers.ServerObjectTrimmer (mergeDuplicatedRootObjects)
import Components.DataProcessors.ListDataProcessor (processReturnedValues,processAggReturnedValues)
import Model.ServerExceptions
import Model.ServerObjectTypes (RootObject,SchemaSpecs,QueryData,AggQueryData)


{- |
   This function is to parse your schema. The return value is passed to the other two functions to interpret your schema. You can declare and define your schema with tuples and lists without reading a json file as defined in below function, but you will not receive type and duplicate checking from this function. You also may run this function once and declare the returned values in code.

   __Schema:__

   The schema json file is formated as one json object to detail the GraphQL objects and the object heirarchy.
   Only "PrimaryObjects" are valid descendants to "Interfaces".
   Only the shared object fields and shared scalar fields are interface fields.
   If a interface is a declared field from a primary object, all interface-interpreted objects are supposed to be declared in database relationships from the primary object with the object property field.
   When declaring any primary object or interface, the pseudonym is supposed to list all possible root object calling references. As a nested object, you should declare the object names in the nested object field definitions in object that's holding property of the object or interface in definition.
   Primary objects are expected to not have all NULL unique id values, and they are otherwise removed from the result when reading the data.
   Database relationships are defined as an ordered sequence from the identity table to the target association table.
   The order is identity table, identity table join field(s), target table, target table join field(s), then (multiple) triplets (of intermediate table, intermediate table to-join field, then intermediate table from-join field in order of nearness from identity table) if relevant.
   If multiple fields are defining the join, one separately declares every field with a space " " separation between ids.
   For example, the declaration is [A,"a b", B, "c d"] if the join condition is "A.a=B.c and A.b=B.d".
   You can add object associations as declaring more object-fields in the primary objects.

   __Scalar fields:__

   Scalar fields are declared with a type, and they are cast to corresponding JSON format when making the GraphQL result.
   Valid scalar field types are Text, Int64, Double, or Boolean (for JSON format).

   __Function exceptions:__

   Exceptions are returned when error is faced. This method returns errors of:

    * ReadSchemaFileException (I could not read file.)
    * SchemaDuplicateServerObjectException (I found duplicate primary object.)
    * SchemaDuplicateInterfaceException (I found duplicate interface server object.)
    * ReadJsonObjectsException (I failed to a read list of json objects. Is it formatted correctly?)
    * ReadServerNameStringException (ServerName is not read correctly.)
    * ReadScalarFieldException (Scalar field is not read correctly.)
    * ReadDatabaseTableException (Database table string is not read correctly.)
    * ReadJsonStringException (String is not read correctly.)
    * ReadPseudonymsException (Pseudonyms string list is not read correctly.)
    * ReadInterfaceInstancesException (Interface instances string list is not read correctly.)
    * ReadDatabaseIdsException (Database ids string list is not read correctly.)
    * ReadJsonStringListException (String list is not read correctly.)
    * ReadDatabaseRelationshipsException (Database relationships [[String]] is not read correctly.)
    * ScalarFieldDataTypeException (Data type is not recognized.)
    * ReadDatabaseRelationshipsCardinalityException (Tables cardinality is unexpected.)
    * PrimaryObjectNotFoundException (Primary object is not found for interface.)
    * SchemaDuplicateException (Duplicate in name, scalar, object fields, or relationships.)
    * InterfaceScalarTypesException (Interface scalars are not same types for scalars of same name in interface interpretations.)
   
   __Schema format example:__

   This is the syntax for the schema file:

   @
    {
      \"Interfaces\":[
        ({
          \"ServerName\":SERVEROBJECTNAME,
          \"Pseudonyms\":[(String)+],
          \"ServerChildren\":[(SERVEROBJECTNAME)+]
        })*
      ],
      \"PrimitiveObjects\":[
        ({
          \"ServerName\": SERVEROBJECTNAME,
          \"Pseudonyms\": [(String)+],
          \"ScalarFields\": [
            ({
              \"Name\": String,
              \"Type\": DATATYPE,
              \"Arguments\": [
                ({
                  \"Name\": String,
                  \"Options\": [
                    ({
                      \"Name\": String,
                      \"Type\": TYPE,
                      \"Prefix\": String,
                      \"Suffix\": String
                    })+
                  ]
                })*
              ]
            })*
          ],
          \"ObjectFields\": [
            ({
              \"Names\": [String],
              \"ServerName\": SERVEROBJECTNAME
            })*
          ],
          \"DatabaseTable\": String,
          \"UniqueIds\": [String],
          \"DatabaseRelationships\": [
            ([FROMTABLE,FROMJOINIDS,TOTABLE,TOJOINIDS(,NEXTTABLEBYFROMTABLE,NEXTABLEENTRYIDS,NEXTTABLEEXITIDS)*])*
          ]
        })+
      ]
    }

    SERVEROBJECTNAME = String
    TYPE = \"Text\" | \"Int64\" | \"Double\" | \"Boolean\"
    FROMTABLE = String
    FROMJOINIDS = String
    TOTABLE = String
    TOJOINIDS = String
    NEXTTABLEBYFROMTABLE = String
    NEXTABLEENTRYIDS = String
    NEXTTABLEEXITIDS = String
   @

   You may find an example in the repo. You should have a database relationship for every object field and every interface interpreted field in a primary object.

   __Schema recommendation:__

   When you add every PrimaryObject as a field to every PrimaryObject, the schema coverage is extended.

   __Closing remark:__

   As the last remark, I will turn attention to a quote from specifications.

   @"In contrast, GraphQL only returns the data that's explicitly requested, so new capabilities can be added via new types and new fields on those types without creating a breaking change. This has lead to a common practice of always avoiding breaking changes and serving a versionless API."@ - <https://graphql.github.io/learn/best-practices/>
  
   With respect to that, you should elaborate on your schema representation. You should give all planned details and make adjustments when you feel to evolve your server with new associations like simple arcs in a graph.
-}
processSchema :: FilePath       -- ^ This is the path to schema json file
              -> IO SchemaSpecs -- ^ The return value is a monad for your schema data.
processSchema :: FilePath -> IO SchemaSpecs
processSchema = FilePath -> IO SchemaSpecs
fetchArguments
{- |
  These two functions are to parse, validate, and interpret your GraphQL query with variables. If you don't have variables, you may pass an empty string. The function is expecting your schema as SchemaSpec type from the above function. You can alternatively define you schema with lists and tuples by calling the above function once and declaring the output as the SchemaSpec argument for this function, so you do not repeatedly parse the json schema file.

  __Function return value:__

  The returned values are one tuple to contain query information to later pass to the data processing function. 
  The tuple is (QueryData,SQLQueries). The second tuple member is a collection of queries to iterate and give to your database.
  Examples are found in this <https://github.com/jasonsychau/graphql-w-persistent repository page>.

  __Function exceptions:__

  Exceptions are returned when error is faced. This method returns errors of:

  * MissingVariableValueException (No value is found for query variable(s).)
  * ReadVariablesJsonException (Variables JSON string is not read correctly.)
  * VariablesSyntaxException (Query syntax error in variables section.)
  * InvalidVariableTypeException (Variable type is not Text, Int64, Double, nor Boolean.)
  * EmptyQueryException (Query is not found.)
  * ParseFragmentException (I found an unexpected character when reading a fragment, imbalanced brackets, or missing syntax.)
  * InvalidObjectException (I found syntax error when reading object in query.)
  * FindFragmentException (I cannot find fragment in given for query.)
  * ReadDirectiveException (I cannot read directive and value combination.)
  * MismatchedVariableTypeException (Given variable is not same type as expected input.)
  * InvalidVariableNameException (Variable is not found by name.)
  * InvalidScalarException (Scalar field declaration is unexpected structure.)
  * TransformationSyntaxException (Transformation is not read correctly.)
  * RelationshipCardinalityException (I found unexpected tables count in database relationship declaration.)
  * RelationshipLinkageIdException (Columns cardinality is different between tables that are linked in join.)
  * UnrecognisedObjectException (Object/Interface is not found in schema; interface object field is not found in schema)
  * UnrecognisedArgumentException (Argument is not found for object scalar field in schema.)
  * UnrecognisedOptionException (Argument option is not found for object scalar field argument (in schema).)
  * UnrecognisedScalarException (Scalar is not found in schema.)
  * DisagreeingObjectFieldsException (Object fields in interface are different server objects.)
  * UnrecognisedRelationshipException (Server object database relationship is not found.)
  * DuplicateObjectsException (multiple objects are sharing same alias, but their subselections are different.)
  * QuerySyntaxException (query syntax is invalid)
  * InvalidPropertiesException (object fields are invalid)
-}
processQueryString :: SchemaSpecs               -- ^ This is the data about your schema
                   -> String                    -- ^ This is the GraphQL query
                   -> String                    -- ^ This is the variables string
                   -> (QueryData,[[[String]]])  -- ^ The return value is a tuple with package objects and list with grouped sql query strings.
processQueryString :: SchemaSpecs -> FilePath -> FilePath -> (QueryData, [[[FilePath]]])
processQueryString (svrobjs :: [(FilePath, [FilePath])]
svrobjs,sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,sos :: [(FilePath, [(FilePath, [FilePath])])]
sos,sodn :: [(FilePath, [FilePath], FilePath)]
sodn,sor :: [(FilePath, FilePath, [FilePath])]
sor,soa :: [(FilePath, [FilePath], [FilePath])]
soa) qry :: FilePath
qry vars :: FilePath
vars =
          let dvars :: [(FilePath, FilePath, FilePath)]
dvars = FilePath -> FilePath -> [(FilePath, FilePath, FilePath)]
parseVariables FilePath
vars FilePath
qry
              str :: FilePath
str = FilePath -> FilePath
processString FilePath
qry
              objs :: RootObjects
objs = if FilePath -> Bool
validateQuery FilePath
str then (FilePath
-> [(FilePath, [FilePath])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [FilePath], [FilePath])]
-> [(FilePath, FilePath, FilePath)]
-> RootObjects
parseStringToObjects FilePath
str [(FilePath, [FilePath])]
svrobjs [(FilePath, [(FilePath, [FilePath])])]
sos [(FilePath, [FilePath], [FilePath])]
soa [(FilePath, FilePath, FilePath)]
dvars) else QueryException -> RootObjects
forall a e. Exception e => e -> a
throw QueryException
QuerySyntaxException
              robjs :: RootObjects
robjs = RootObjects -> RootObjects
mergeDuplicatedRootObjects (RootObjects -> RootObjects) -> RootObjects -> RootObjects
forall a b. (a -> b) -> a -> b
$ [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [(FilePath, FilePath, FilePath)]
-> RootObjects
replaceObjectsVariables [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], [FilePath])]
soa RootObjects
objs [(FilePath, FilePath, FilePath)]
dvars
              (tbls :: [[[(Int, Bool, FilePath)]]]
tbls,qrys :: [[[FilePath]]]
qrys) = if [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], [FilePath])] -> RootObjects -> Bool
checkObjectsAttributes [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], [FilePath])]
soa RootObjects
robjs then ([(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, FilePath, [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> ([[[(Int, Bool, FilePath)]]], [[[FilePath]]])
makeSqlQueries [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], FilePath)]
sodn [(FilePath, FilePath, [FilePath])]
sor [(FilePath, [FilePath], [FilePath])]
soa RootObjects
robjs) else ReferenceException -> ([[[(Int, Bool, FilePath)]]], [[[FilePath]]])
forall a e. Exception e => e -> a
throw ReferenceException
InvalidPropertiesException
          in (RootObjects -> [[[(Int, Bool, FilePath)]]] -> QueryData
forall a b. [a] -> [b] -> [(a, b)]
zip RootObjects
robjs [[[(Int, Bool, FilePath)]]]
tbls,[[[FilePath]]]
qrys)
{- |
  Not all databases are providing support for json aggregation in sql queries, so you may use the above function for those cases. This function is returning queries with json aggregation to format output in the database. It is faster.
-}
processAggQueryString :: SchemaSpecs                 -- ^ This is the data about your schema
                     -> String                       -- ^ This is the GraphQL query
                     -> String                       -- ^ This is the variables string
                     -> (AggQueryData,[[[String]]])  -- ^ The return value is a tuple with package objects and list with grouped sql query strings.
processAggQueryString :: SchemaSpecs
-> FilePath -> FilePath -> (AggQueryData, [[[FilePath]]])
processAggQueryString (svrobjs :: [(FilePath, [FilePath])]
svrobjs,sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,sos :: [(FilePath, [(FilePath, [FilePath])])]
sos,sodn :: [(FilePath, [FilePath], FilePath)]
sodn,sor :: [(FilePath, FilePath, [FilePath])]
sor,soa :: [(FilePath, [FilePath], [FilePath])]
soa) qry :: FilePath
qry vars :: FilePath
vars =
          let dvars :: [(FilePath, FilePath, FilePath)]
dvars = FilePath -> FilePath -> [(FilePath, FilePath, FilePath)]
parseVariables FilePath
vars FilePath
qry
              str :: FilePath
str = FilePath -> FilePath
processString FilePath
qry
              objs :: RootObjects
objs = if FilePath -> Bool
validateQuery FilePath
str then (FilePath
-> [(FilePath, [FilePath])]
-> [(FilePath, [(FilePath, [FilePath])])]
-> [(FilePath, [FilePath], [FilePath])]
-> [(FilePath, FilePath, FilePath)]
-> RootObjects
parseStringToObjects FilePath
str [(FilePath, [FilePath])]
svrobjs [(FilePath, [(FilePath, [FilePath])])]
sos [(FilePath, [FilePath], [FilePath])]
soa [(FilePath, FilePath, FilePath)]
dvars) else QueryException -> RootObjects
forall a e. Exception e => e -> a
throw QueryException
QuerySyntaxException
              robjs :: RootObjects
robjs = RootObjects -> RootObjects
mergeDuplicatedRootObjects (RootObjects -> RootObjects) -> RootObjects -> RootObjects
forall a b. (a -> b) -> a -> b
$ [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [(FilePath, FilePath, FilePath)]
-> RootObjects
replaceObjectsVariables [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], [FilePath])]
soa RootObjects
objs [(FilePath, FilePath, FilePath)]
dvars
              (tbls :: [[[(Int, Int, Bool, FilePath)]]]
tbls,qrys :: [[[FilePath]]]
qrys) = if [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], [FilePath])] -> RootObjects -> Bool
checkObjectsAttributes [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], [FilePath])]
soa RootObjects
robjs then ([(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, FilePath, [FilePath])]
-> [(FilePath, [FilePath], [FilePath])]
-> [[FlagNode]]
-> RootObjects
-> ([[[(Int, Int, Bool, FilePath)]]], [[[FilePath]]])
makeSqlAggQueries [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], FilePath)]
sodn [(FilePath, FilePath, [FilePath])]
sor [(FilePath, [FilePath], [FilePath])]
soa ([(FilePath, [FilePath], [FilePath])] -> RootObjects -> [[FlagNode]]
flagOneWay [(FilePath, [FilePath], [FilePath])]
soa RootObjects
robjs) RootObjects
robjs) else ReferenceException
-> ([[[(Int, Int, Bool, FilePath)]]], [[[FilePath]]])
forall a e. Exception e => e -> a
throw ReferenceException
InvalidPropertiesException
          in (RootObjects -> [[[(Int, Int, Bool, FilePath)]]] -> AggQueryData
forall a b. [a] -> [b] -> [(a, b)]
zip RootObjects
robjs [[[(Int, Int, Bool, FilePath)]]]
tbls,[[[FilePath]]]
qrys)
{- |
  These two functions are for processing database query results to GraphQL style. You must correspond the respective function to the function from the above two in your application.

  The first four arguments are function to translate your database value types to the declared type for the field. Examples are found in <https://github.com/jasonsychau/graphql-w-persistent repo>,

  The fifth argument is a function to check if the database returned value is a null. This is for checking existence of values present.

  The seventh argument is the query data from processQueryString or processAggQueryString.
  
  The return result is a string to resemble a GraphQL return value.

  __Function exceptions:__

  Exceptions are returned when error is faced. This method returns errors of:

  * InvalidVariableTypeException (Variable type is not Text, Int64, Double, nor Boolean.)
  * ReadJsonException (Could not read json from database)
-}
processQueryData :: (Eq a)
                 => (a -> Text)   -- ^ This is a function to transform database type to string
                 -> (a -> Double) -- ^ This is a function to transform database type to Double
                 -> (a -> Int64)  -- ^ This is a function to transform database type to Int64
                 -> (a -> Bool)   -- ^ This is a function to transform database type to boolean
                 -> (a -> Bool)   -- ^ This is a function to check for NULL data
                 -> SchemaSpecs   -- ^ This is the schema data from the first method
                 -> QueryData     -- ^ This is the package objects that is from processQueryString function.
                 -> [[[[[a]]]]]   -- ^ This is the database query results value in the same order.
                 -> String        -- ^ The return value is a string type to describe the GraphQL-organized return values.
processQueryData :: (a -> Text)
-> (a -> Double)
-> (a -> Int64)
-> (a -> Bool)
-> (a -> Bool)
-> SchemaSpecs
-> QueryData
-> [[[[[a]]]]]
-> FilePath
processQueryData toTxt :: a -> Text
toTxt toDbl :: a -> Double
toDbl toInt :: a -> Int64
toInt toBool :: a -> Bool
toBool isNull :: a -> Bool
isNull (_,sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,_,sodn :: [(FilePath, [FilePath], FilePath)]
sodn,_,soa :: [(FilePath, [FilePath], [FilePath])]
soa) qd :: QueryData
qd dt :: [[[[[a]]]]]
dt =
          let (ro :: RootObjects
ro,tb :: [[[(Int, Bool, FilePath)]]]
tb) = QueryData -> (RootObjects, [[[(Int, Bool, FilePath)]]])
forall a b. [(a, b)] -> ([a], [b])
unzip QueryData
qd
          in (a -> Text, a -> Double, a -> Int64, a -> Bool, a -> Bool)
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [[[(Int, Bool, FilePath)]]]
-> [[[[[a]]]]]
-> FilePath
forall a.
Eq a =>
(a -> Text, a -> Double, a -> Int64, a -> Bool, a -> Bool)
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [[[(Int, Bool, FilePath)]]]
-> [[[[[a]]]]]
-> FilePath
processReturnedValues (a -> Text
toTxt,a -> Double
toDbl,a -> Int64
toInt,a -> Bool
toBool,a -> Bool
isNull) [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], FilePath)]
sodn [(FilePath, [FilePath], [FilePath])]
soa RootObjects
ro [[[(Int, Bool, FilePath)]]]
tb [[[[[a]]]]]
dt
{- |
  This function is for processAggQueryString correspondence.
-}
processAggQueryData :: (Eq a)
                    => (a -> Text)   -- ^ This is a function to transform database type to string
                    -> (a -> Double) -- ^ This is a function to transform database type to Double
                    -> (a -> Int64)  -- ^ This is a function to transform database type to Int64
                    -> (a -> Bool)   -- ^ This is a function to transform database type to boolean
                    -> (a -> Bool)   -- ^ This is a function to check for NULL data
                    -> SchemaSpecs   -- ^ This is the schema data from the first method
                    -> AggQueryData  -- ^ This is the package objects that is from processQueryString function.
                    -> [[[[[a]]]]]   -- ^ This is the database query results value in the same order.
                    -> String        -- ^ The return value is a string type to describe the GraphQL-organized return values.
processAggQueryData :: (a -> Text)
-> (a -> Double)
-> (a -> Int64)
-> (a -> Bool)
-> (a -> Bool)
-> SchemaSpecs
-> AggQueryData
-> [[[[[a]]]]]
-> FilePath
processAggQueryData toTxt :: a -> Text
toTxt toDbl :: a -> Double
toDbl toInt :: a -> Int64
toInt toBool :: a -> Bool
toBool isNull :: a -> Bool
isNull (_,sss :: [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss,_,sodn :: [(FilePath, [FilePath], FilePath)]
sodn,_,soa :: [(FilePath, [FilePath], [FilePath])]
soa) qd :: AggQueryData
qd dt :: [[[[[a]]]]]
dt =
          let (ro :: RootObjects
ro,tb :: [[[(Int, Int, Bool, FilePath)]]]
tb) = AggQueryData -> (RootObjects, [[[(Int, Int, Bool, FilePath)]]])
forall a b. [(a, b)] -> ([a], [b])
unzip AggQueryData
qd
          in (a -> Text, a -> Double, a -> Int64, a -> Bool, a -> Bool)
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [[[(Int, Int, Bool, FilePath)]]]
-> [[[[[a]]]]]
-> FilePath
forall a.
Eq a =>
(a -> Text, a -> Double, a -> Int64, a -> Bool, a -> Bool)
-> [(FilePath,
     [(FilePath, FilePath,
       [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
-> [(FilePath, [FilePath], FilePath)]
-> [(FilePath, [FilePath], [FilePath])]
-> RootObjects
-> [[[(Int, Int, Bool, FilePath)]]]
-> [[[[[a]]]]]
-> FilePath
processAggReturnedValues (a -> Text
toTxt,a -> Double
toDbl,a -> Int64
toInt,a -> Bool
toBool,a -> Bool
isNull) [(FilePath,
  [(FilePath, FilePath,
    [(FilePath, [(FilePath, FilePath, FilePath, FilePath)])])])]
sss [(FilePath, [FilePath], FilePath)]
sodn [(FilePath, [FilePath], [FilePath])]
soa RootObjects
ro [[[(Int, Int, Bool, FilePath)]]]
tb [[[[[a]]]]]
dt