graphql-w-persistent 0.8.0.0 → 0.9.0.0

raw patch · 15 files changed

+980/−1127 lines, 15 filesdep ~basedep ~jsonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, json

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• graphql-w-persistent.cabal +7/−6
• src/Components/DataProcessors/ListDataProcessor.hs +200/−172
• src/Components/ObjectHandlers/ObjectsHandler.hs +43/−49
• src/Components/ObjectHandlers/ServerObjectInspector.hs +124/−0
• src/Components/ObjectHandlers/ServerObjectTrimmer.hs +5/−9
• src/Components/ObjectHandlers/ServerObjectValidator.hs +0/−103
• src/Components/Parsers/QueryParser.hs +38/−79
• src/Components/Parsers/ServerSchemaJsonParser.hs +58/−54
• src/Components/Parsers/VariablesParser.hs +17/−19
• src/Components/QueryComposers/SQLQueryComposer.hs +241/−93
• src/Components/Util.hs +14/−0
• src/GraphQLdbi.hs +173/−510
• src/Model/ServerExceptions.hs +51/−29
• src/Model/ServerObjectTypes.hs +5/−4

@@ -1,5 +1,9 @@ # Revision history for graphql-w-persistent +## 0.9.0.0 -- 2020-06-01++* Null values are now supported; table are now supported to appear more than once in joins; data types are simplified for .json file support; alternative json aggregate SQL query functions are now supported for faster queries; error is fixed from version 0.8.0.0 for more than two nested objects; inline fragments were not working in version 0.8.0.0, but it is now working; and removed a requirement for "Unexpected nulls" for null values which is making easy compliance with other databases packages and types.+ ## 0.8.0.0 -- 2019-12-28  * reduce space footprint by querying objects individually and only once per reference

@@ -10,13 +10,13 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.8.0.0+version:             0.9.0.0  -- A short (one-line) description of the package. synopsis:            GraphQL interface middleware for (SQL) databases.  -- A longer description of the package.-description:         This is a Haskell GraphQL query parser and interpreter for databases. There is data processing to return GraphQL object formats. The query parser and interpreter are always applicable (on available database query types which is only SQL for now). It is accepting any string query, and it is returning a list of string database-queries. The data processing function is designed about the return values from the Persistent library (casted as Text data values from PersistValue). With another database package with same data structure on the returned values from the database, this whole package is applicable. Examples are odbc package query function and HDBC package quickQuery. To read more detailed information, you should go to the below module page.+description:         This is an application of GraphQL to querying SQL databases. The package functions are to interpret GraphQL string queries, to make SQL queries, and to process list-style database-returned values into a GraphQL string output (which you may use with another program). The data processing functions are designed for the Persistent library return values, but any (Eq a) => [[a]] returned type is valid input to this library if translations (and a check for null value) are provided for data types (Text, Int64, Double, and Boolean). Prospect packages are the odbc package (with the query function) and HDBC package (with the quickQuery function). You may find another to suit your stack. Examples and applications are available at the homepage (GitHub). I would like a star while you are there.  -- URL for the project homepage or repository. homepage:            https://github.com/jasonsychau/graphql-w-persistent@@ -48,7 +48,7 @@ -- Constraint on the version of Cabal needed to build this package. cabal-version:       >=1.10 -tested-with:         GHC==8.6.5+tested-with:         GHC >=8.2.2 && <=8.8.3 stability:           provisional bug-reports:         https://github.com/jasonsychau/graphql-w-persistent/issues @@ -63,12 +63,13 @@   -- Modules included in this library but not exported.   other-modules:       Components.DataProcessors.ListDataProcessor,                        Components.ObjectHandlers.ObjectsHandler,-                       Components.ObjectHandlers.ServerObjectValidator,+                       Components.ObjectHandlers.ServerObjectInspector,                        Components.ObjectHandlers.ServerObjectTrimmer,                        Components.Parsers.VariablesParser,                        Components.Parsers.ServerSchemaJsonParser,                        Components.Parsers.QueryParser,                        Components.QueryComposers.SQLQueryComposer,+                       Components.Util                        Model.ServerObjectTypes,                        Model.ServerExceptions @@ -76,9 +77,9 @@   --other-extensions:    -- Other library packages from which modules are imported.-  build-depends:       base >=4.11 && <4.13,+  build-depends:       base >=4.10.1.0 && <4.14,                        containers >=0.5 && <0.7,-                       json >=0.9 && <0.10,+                       json >=0.9.1 && <0.11,                        text >=1.2 && <1.3  

@@ -1,17 +1,25 @@-module Components.DataProcessors.ListDataProcessor (processReturnedValues) where+module Components.DataProcessors.ListDataProcessor (processReturnedValues,processAggReturnedValues) where  import Data.Text (Text,unpack,pack)-import Text.JSON (showJSON,showJSONs,JSValue,JSObject,toJSObject,encodeStrict)+import Data.List (unzip4)+import Text.JSON (+    showJSON,+    showJSONs,+    JSValue,+    JSObject,+    toJSObject,+    encodeStrict,+    JSValue(JSNull),+    JSON(..),+    Result(Ok),+    decode+  ) import Control.Exception (throw) import Data.Foldable (foldl',foldr')+import Data.Int (Int64) import Model.ServerExceptions (-    QueryException(-      InvalidObjectException,-      InvalidScalarException,-      InvalidArgumentException,-      EOFDataProcessingException,-      InvalidVariableTypeException-    )+    VariableException(InvalidVariableTypeException),+    QueryException(ReadJsonException)   ) import Model.ServerObjectTypes (     NestedObject(..),@@ -30,182 +38,202 @@     translateTableToObject,     countTableIds   )-+import Components.Util (fst3,snd3,thd3,fst4,thd4,fth4)  -- root objects to one json representation of separate graphql results-processReturnedValues :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Bool,String)]]] -> [[[[[Text]]]]] -> String-processReturnedValues sss sodn soa robjs tbls rlts = encodeStrict $ processReturnedValuesToJsonObject sss sodn soa robjs tbls rlts-processReturnedValuesToJsonObject :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Bool,String)]]] -> [[[[[Text]]]]] -> JSObject (JSObject JSValue)-processReturnedValuesToJsonObject sss sodn soa robjs tbls rlts = toJSObject [("data", toJSObject [processReturnedValue sss sodn soa x y z | (x,y,z) <- zip3 robjs tbls rlts])]+processReturnedValues :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Bool,String)]]] -> [[[[[a]]]]] -> String+processReturnedValues transFx sss sodn soa robjs tbls rlts = encodeStrict $ processReturnedValuesToJsonObject transFx sss sodn soa robjs tbls rlts+processReturnedValuesToJsonObject :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Bool,String)]]] -> [[[[[a]]]]] -> JSObject (JSObject JSValue)+processReturnedValuesToJsonObject transFx sss sodn soa robjs tbls rlts = toJSObject [("data", toJSObject [processReturnedValueByRootObject transFx sss sodn soa a b c | (a,b,c) <- zip3 robjs tbls rlts])] -- qraphql query object and sql return data to json representation on graphql query results-processReturnedValue :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> RootObject -> [[(Int,Bool,String)]] -> [[[[Text]]]] -> (String, JSValue)-processReturnedValue sss sodn soa (NestedObject Nothing name sobj _ sfs) tbls rlts = (name, showJSONs $ processSubFields sss sodn soa sobj tbls sfs rlts)-processReturnedValue sss sodn soa (NestedObject (Just alias) name sobj _ sfs) tbls rlts = (alias, showJSONs $ processSubFields sss sodn soa sobj tbls sfs rlts)+processReturnedValueByRootObject :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> RootObject -> [[(Int,Bool,String)]] -> [[[[a]]]] -> (String, JSValue)+processReturnedValueByRootObject transFx sss sodn soa (NestedObject Nothing name sobj _ sfs) tbls rlts = (name, showJSONs $ packageSubFields transFx sss sodn soa sobj tbls sfs rlts)+processReturnedValueByRootObject transFx sss sodn soa (NestedObject (Just alias) name sobj _ sfs) tbls rlts = (alias, showJSONs $ packageSubFields transFx sss sodn soa sobj tbls sfs rlts) -- SubFields and data rows to json representation on qraphql query data-processSubFields :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[Text]]]] -> [JSValue]-processSubFields sss sodn soa sobj tbls (sf:sfs) (vRlt:rlts)-    | all (\x -> (null x)||(null $ head x)) (vRlt:rlts) = [] -- all first query (object query) are no results (or no query)-    | oneObject&&(null object)==False = (showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls (sf:sfs) remData)-    | oneObject = processSubFields sss sodn soa sobj tbls (sf:sfs) remData-    | otherwise = [showJSON $ toJSObject x | x<-objects, (null x)==False]++(processSubFields sss sodn soa sobj tbls (sf:sfs) remData)+packageSubFields :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[a]]]] -> [JSValue]+packageSubFields transFx sss sodn soa sobj tbls sfs rlts = packageSubFieldsForEveryRow transFx sss sodn soa sobj sfs grpdInstcByObjInst   where-    oneObject = all (\x -> (null x)||((snd3 $ head x)==False)) $ tail tbls-    zDta = zip3 tbls (vRlt:rlts) idCounts-    object = makeOneGQLObject sss sodn soa sobj tbls (sf:sfs) [fetchGraphQlRow dt idC | (_,dt,idC)<-zDta]-    notEmptyQueryResults = [(x,y,z) | (x,y,z)<-zDta,(null x)==False,(null y)==False,(null $ head y)==False]-    -- groupedData :: [[([(Int,Bool,String)],[[[Text]]])]]-    groupedData = foldl' (\z (x,y) ->if (null z)==True then [[(x,y)]] else if (null x)||((snd3 $ head x)==False) then ((init z)++[(last z)++[(x,y)]]) else (z++[[(x,y)]])) [] $ [(x,fetchGraphQlRow y z) | (x,y,z)<-notEmptyQueryResults]-    -- labeledData :; [([[(Int,Bool,String)]],[[[[Text]]]])]-    labeledData = [unzip x | x<-groupedData]-    objects = foldr (\(x,y) z -> (makeOneGQLObject sss sodn soa sobj x (sf:sfs) y):z) [] labeledData-    remData = [removeDataRow x idC | (_, x, idC)<-zDta]-    idCounts = if (null tbls)||(null $ head tbls) then [] else foldl' (\y x -> if (null x) then y++[0] else if (not $ snd3 $ head x) then y++[last y] else y++[countTableIds (thd3 $ head x) sodn]) [countTableIds (thd3 $ head $ head tbls) sodn] $ tail tbls-processSubFields _ _ _ _ _ _ [] = [] -- no variants (maybe not possible)-processSubFields _ _ _ _ _ [] _ = [] -- no fields (when finished)-      -thd3 :: (a,b,c) -> c-thd3 (_,_,x) = x-snd3 :: (a,b,c) -> b-snd3 (_,x,_) = x+    dtaByInstCbntn = zip tbls rlts+    grpdInstcByObjInst = foldl' (\rlt (nInst,nDta)->if (snd3 $ head nInst)==False then+          ((init rlt)++[(last rlt)++[(nInst,(nDta,snd $ snd $ head $ last rlt))]])+        else+          rlt++[[(nInst,(nDta,countTableIds (thd3 $ head nInst) sodn))]]) [[(fst $ head dtaByInstCbntn,(snd $ head dtaByInstCbntn,countTableIds (thd3 $ head $ fst $ head dtaByInstCbntn) sodn))]] $ tail dtaByInstCbntn+packageSubFieldsForEveryRow :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [Field] -> [[([(Int,Bool,String)],([[[a]]],Int))]] -> [JSValue]+packageSubFieldsForEveryRow transFx sss sodn soa sobj (sf:sfs) dt = if null objWInst then [] else (++) objects $ packageSubFieldsForEveryRow transFx sss sodn soa sobj (sf:sfs) remIs+  where+    (_,_,_,_,isNull) = transFx+    objInstWRw = map (filter (\(_,(nDt,_))->(null $ head nDt)==False)) dt+    objWInst = filter (not . null) objInstWRw+    (nxtObjsRw,remIs) = foldl' (\(objRows,remRows) nObj->+      let (nObjRow,nObjRem) = foldl' (\(nInstRow,nInstRem) (tbls,(dSet,idC))->let (rowData,remData) = separateGqlRow isNull idC dSet in (nInstRow++[(tbls,rowData)],nInstRem++[(tbls,(remData,idC))])) ([],[]) nObj+      in (objRows++[unzip nObjRow],remRows++[nObjRem])) ([],[]) objWInst+    objects = map (\(nTbl,nDt)->showJSON $ toJSObject $ makeOneGQLObject transFx sss sodn soa sobj nTbl (sf:sfs) nDt) nxtObjsRw+packageSubFieldsForEveryRow transFx sss sodn soa sobj [] dt = [] -makeOneGQLObject :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[Text]]]] -> [(String,JSValue)]-makeOneGQLObject _ _ _ _ [] _ _ = throw EOFDataProcessingException  -- no reference tables (unusual)-makeOneGQLObject _ _ _ _ ([]:_) _ _ = throw EOFDataProcessingException  -- no reference tables in first varient (unusual)-makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) dat = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (thd3 $ head $ head tbls) sodn):(makeOneGQLObject sss sodn soa sobj tbls b dat)-makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) ((((i:j):k):l):m) = (getScalarFieldLabel $ ScalarType alias name trans arg, castJSType (findPrimitiveScalarTypeType (translateTableToObject (thd3 $ head $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObject sss sodn soa sobj tbls b (((j:k):l):m))-makeOneGQLObject sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) ((j:k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs (processSubFields sss sodn soa nso nxtTbls sfs nxtData)):(makeOneGQLObject sss sodn soa sobj remTbls b remData)+makeOneGQLObject :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[a]]]] -> [(String,JSValue)]+makeOneGQLObject _ _ _ _ _ [] _ _ = error "EOF data processing (source error)"  -- no reference tables (unusual)/all removed+makeOneGQLObject _ _ _ _ _ ([]:_) _ _ = error "EOF data processing (source error)"  -- no reference tables in first varient (unusual)+makeOneGQLObject transFx sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) dat = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (thd3 $ head $ head tbls) sodn):(makeOneGQLObject transFx sss sodn soa sobj tbls b dat)+makeOneGQLObject (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) ((((i:j):k):l):m) = (getScalarFieldLabel $ ScalarType alias name trans arg, if isNull i then JSNull else castJSType (fx1,fx2,fx3,fx4,isNull) (findPrimitiveScalarTypeType (translateTableToObject (thd3 $ head $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObject (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls b (((j:k):l):m))+makeOneGQLObject transFx sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) ((j:k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs (packageSubFields transFx sss sodn soa nso nxtTbls sfs nxtData)):(makeOneGQLObject transFx sss sodn soa sobj remTbls b remData)   where-    (nxtTbls,nxtData,remTbls,remData) = separateObjectData tbls ((j:k):l)-makeOneGQLObject sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) dat-  | (isServerObjectTable (thd3 $ head $ head tbls) ifo sodn soa)==True = makeOneGQLObject sss sodn soa sobj tbls (sfs++b) dat-  | otherwise = makeOneGQLObject sss sodn soa sobj tbls b dat-makeOneGQLObject _ _ _ _ _ [] ((([]:_):_):_) = []  -- no columns (in first variant and first query) and no fields (done)-makeOneGQLObject _ _ _ _ _ _ (([]:_):_) = []  -- no rows (no data)-makeOneGQLObject _ _ _ _ _ ((Right (Left _)):[]) ([]:_) = throw EOFDataProcessingException  -- field and no queries (unusual)-makeOneGQLObject _ _ _ _ _ _ ([]:_) = []  -- no queries (no data)-makeOneGQLObject _ _ _ _ _ _ [] = []  -- no variants (unusual)-makeOneGQLObject _ _ _ _ _ [] _ = [] -- columns and no fields (done or error)-makeOneGQLObject _ _ _ _ _ ((Left _):_) ((([]:_):_):_) = throw EOFDataProcessingException  -- field and no result columns+    (nxtTbls,nxtData,remTbls,remData) = separateDataFrNstdObj tbls ((j:k):l)+makeOneGQLObject transFx sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) dat = if (isServerObjectTable (thd3 $ head $ head tbls) ifo sodn soa) then makeOneGQLObject transFx sss sodn soa sobj tbls (sfs++b) dat else makeOneGQLObject transFx sss sodn soa sobj tbls b dat+makeOneGQLObject _ _ _ _ _ _ [] ((([]:_):_):_) = []  -- no columns (in first variant and first query) and no fields (done)+makeOneGQLObject _ _ _ _ _ _ _ (([]:_):_) = []  -- no rows (no data)+makeOneGQLObject _ _ _ _ _ _ ((Right (Left _)):[]) ([]:_) = error "EOF data processing (source error)"  -- field and no queries (unusual)+makeOneGQLObject _ _ _ _ _ _ _ ([]:_) = []  -- no queries (no data)+makeOneGQLObject _ _ _ _ _ _ _ [] = []  -- no instance combination (unusual)+makeOneGQLObject _ _ _ _ _ _ [] _ = [] -- columns and no fields (done or error)+makeOneGQLObject _ _ _ _ _ _ ((Left _):_) ((([]:_):_):_) = error "EOF data processing (source error)"  -- field and no result columns -separateObjectData :: [[(Int,Bool,String)]] -> [[[[Text]]]] -> ([[(Int,Bool,String)]],[[[[Text]]]],[[(Int,Bool,String)]],[[[[Text]]]])-separateObjectData info dat = foldl' (\(nTbls,nDt,rTbls,rDt) (meta,ndt)-> let-        mty = null meta-        one = (length meta)==1-        newMeta = if mty||one then [] else (lvl,fst,tbl):(take (objQryCount-1) flwObjs)-        newData = if mty then [] else if fFst then take (length newMeta) nxtDat else if tblPos<=((length newMeta)-1) then take ((length nxtObjs)-tblPos) ndt else []-        remMeta = if mty then [] else if one then meta else (head meta):(drop objQryCount $ nxtObjs)-        remData = if mty then [] else if fFst then (head ndt):(drop objQryCount nxtDat) else if tblPos<=(objQryCount-1) then [] else ndt        -        nxtObjs = tail meta-        flwObjs = tail nxtObjs-        nxtDat = tail ndt-        (lvl,fst,tbl) = head nxtObjs-        objQryCount = foldr' (\(nlvl,nfst,ntbl) y->if nlvl<=lvl then 1 else y+1) 1 flwObjs-        tblPos = foldr' (\(idx,(_,fst,_)) y->if fst then idx else y) ((length nxtObjs)-1) $ zip [0..] $ nxtObjs-        (_,fFst,_) = head meta-      in      -        (nTbls++[newMeta],nDt++[newData],rTbls++[remMeta],rDt++[remData])) ([],[],[],[]) $ zip info dat+separateDataFrNstdObj :: [[(Int,Bool,String)]] -> [[[[a]]]] -> ([[(Int,Bool,String)]],[[[[a]]]],[[(Int,Bool,String)]],[[[[a]]]])+separateDataFrNstdObj info dat =+    foldl' (\(nTbls,nDt,rTbls,rDt) (instMt,instDt)->+      let+        nxtTblsInfo = tail instMt+        tNxtTblsInfo = tail nxtTblsInfo+        (objLvl,_,_) = head nxtTblsInfo+        nestedObjCount = foldr' (\(nlvl,_,_) rlt->if nlvl<=objLvl then 0 else rlt+1) 0 tNxtTblsInfo+        fQrydPos = foldr' (\(idx,(_,fst,_)) rlt->if fst then idx else rlt) ((length nxtTblsInfo)-1) $ zip [0..] nxtTblsInfo+        hasQrd = (<=) fQrydPos nestedObjCount+        (nObjMeta,nObjData,remMeta,remData) = if hasQrd then+            ([tail instMt],[instDt],[],[])+          else+            ([],[],[(head instMt):(drop (nestedObjCount+1) $ tail instMt)],[instDt])+      in+        (nTbls++nObjMeta,nDt++nObjData,rTbls++remMeta,rDt++remData))+    ([fstNObjMeta],[fstNObjData],[fstRemMeta],[fstRemData]) $ +    tail $ zip info dat+  where+    fstInstInfo = head info+    fstInstDat = head dat+    (fstL,fstF,fstT) = head fstInstInfo+    nObjPlusTblsInfo = tail fstInstInfo+    nObjLvl = (+) fstL 1+    nstdObjsCount = foldr' (\(nlvl,_,_) rlt->if (==) nlvl nObjLvl then 1 else (+) rlt 1) 1 $ tail nObjPlusTblsInfo+    fstNObjMeta = take nstdObjsCount nObjPlusTblsInfo+    nObjPlusDat = tail $ fstInstDat+    fstNObjData = take nstdObjsCount nObjPlusDat+    fstRemMeta = (fstL,fstF,fstT):(drop nstdObjsCount nObjPlusTblsInfo)+    fstRemData = (head $ fstInstDat):(drop nstdObjsCount nObjPlusDat)  findPrimitiveScalarTypeType :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> String-findPrimitiveScalarTypeType sobj name trans arg ((obj,flds):rst)- | sobj==obj = findScalarTypeType name trans arg flds- | otherwise = findPrimitiveScalarTypeType sobj name trans arg rst-findPrimitiveScalarTypeType _ _ _ _ [] = throw InvalidObjectException+findPrimitiveScalarTypeType sobj name trans arg ((obj,flds):rst) = if sobj==obj then findScalarTypeType name trans arg flds else findPrimitiveScalarTypeType sobj name trans arg rst+findPrimitiveScalarTypeType _ _ _ _ [] = error "Object is not found (source error)." findScalarTypeType :: String -> Transformation -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> String-findScalarTypeType name Nothing _ ((sName,sType,opts):rst)- | name==sName = sType- | otherwise = findScalarTypeType name Nothing Nothing rst-findScalarTypeType name (Just trans) arg ((sName,sType,args):rst)- | name==sName = findArgumentOptionType trans arg args- | otherwise = findScalarTypeType name (Just trans) arg rst-findScalarTypeType _ _ _ [] = throw InvalidScalarException+findScalarTypeType name Nothing _ ((sName,sType,opts):rst) = if name==sName then sType else findScalarTypeType name Nothing Nothing rst+findScalarTypeType name (Just trans) arg ((sName,sType,args):rst) = if name==sName then findArgumentOptionType trans arg args else findScalarTypeType name (Just trans) arg rst+findScalarTypeType _ _ _ [] = error "Scalar is not found (source error)." findArgumentOptionType :: String -> Argument -> [(String,[(String,String,String,String)])] -> String-findArgumentOptionType trans Nothing ((aname,[]):rst)- | trans==aname = throw InvalidArgumentException- | otherwise = findArgumentOptionType trans Nothing rst-findArgumentOptionType trans Nothing ((aname,((_,typ,_,_):_)):rst)- | trans==aname = typ- | otherwise = findArgumentOptionType trans Nothing rst-findArgumentOptionType trans (Just arg) ((aname,opts):rst)- | trans==aname = findOptionType arg opts- | otherwise = findArgumentOptionType trans (Just arg) rst-findArgumentOptionType _ _ [] = throw InvalidArgumentException+findArgumentOptionType trans Nothing ((aname,((_,typ,_,_):_)):rst) = if trans==aname then typ else findArgumentOptionType trans Nothing rst+findArgumentOptionType trans Nothing ((aname,[]):rst) = if trans==aname then error "Scalar argument is not found (source error)." else findArgumentOptionType trans Nothing rst+findArgumentOptionType trans (Just arg) ((aname,opts):rst) = if trans==aname then findOptionType arg opts else findArgumentOptionType trans (Just arg) rst+findArgumentOptionType _ _ [] = error "Scalar argument is not found (source error)." findOptionType :: String -> [(String,String,String,String)] -> String-findOptionType arg ((oname,typ,_,_):rst)- | arg==oname = typ- | otherwise = findOptionType arg rst-findOptionType _ [] = throw InvalidArgumentException+findOptionType arg ((oname,typ,_,_):rst) = if arg==oname then typ else findOptionType arg rst+findOptionType _ [] = error "Scalar argument option is not found (source error)." -fetchGraphQlRow :: [[[Text]]] -> Int -> [[[Text]]]-fetchGraphQlRow _ 0 = [] -- no queries-fetchGraphQlRow [] _ = [] -- no queries-fetchGraphQlRow ([]:_) _ = [] -- no query results for object-fetchGraphQlRow rlts idCols = if (all ((==) nll) firstIds) then [] else-                                [[drop idCols rw | rw<-qryRlt, (take idCols rw)==firstIds] | qryRlt<-rlts]-                              where-                                firstIds = take idCols $ head $ head rlts-                                nll = pack "Unexpected null"-removeDataRow :: [[[Text]]] -> Int -> [[[Text]]]-removeDataRow _ 0 = [] -- no queries-removeDataRow ([]:_) _ = [] -- no query results for object-removeDataRow rlts idCols = [[rw | rw<-qryRlt, (take idCols rw)/=firstIds] | qryRlt<-rlts]-                              where firstIds = take idCols $ head $ head rlts+separateGqlRow :: (Eq a) => (a -> Bool) -> Int -> [[[a]]] -> ([[[a]]],[[[a]]])+separateGqlRow isNull idCnt dat = if (all isNull fstTblIds) then+                                    unzip [([],[row | row<-tbl, not $ all isNull $ take idCnt row]) | tbl<-dat]+                                  else+                                    getGqlRow idCnt fstTblIds dat [] []+                                  where+                                    fstTblIds = take idCnt $ head $ head dat                    +getGqlRow :: (Eq a) => Int -> [a] -> [[[a]]] -> [[[a]]] -> [[[a]]] -> ([[[a]]],[[[a]]])+getGqlRow _ _ [] tblsRows tblsRem = (tblsRows,tblsRem)+getGqlRow idCnt fstIds (tbl:dat) tblsRows tblsRem = getGqlRow idCnt fstIds dat (tblsRows++[nxtRow]) (tblsRem++[nxtRem])+                                                  where+                                                    (nxtRow,nxtRem) = foldl' (\(rowRlt,remRlt) row -> if (==) fstIds $ take idCnt row then+                                                        (rowRlt++[drop idCnt row],remRlt)+                                                      else+                                                        (rowRlt,remRlt++[row])) ([],[]) tbl +castJSType :: ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> String -> a -> JSValue+castJSType (toText,_,_,_,_) "Text" val = showJSON $ toText val+castJSType (_,toNum,_,_,_) "Double" val = showJSON $ toNum val+castJSType (_,_,toInt,_,_) "Int64" val = showJSON $ toInt val+castJSType (_,_,_,toBool,_) "Boolean" val = showJSON $ toBool val+castJSType _ _ _ = throw InvalidVariableTypeException --- pullNDataColumns :: Int -> [[Text]] -> [[Text]]--- pullNDataColumns _ [] = []--- pullNDataColumns cnt rslt---  | (cnt<0) = throw InvalidArgumentException---  | otherwise = [if (length x)<cnt then throw EOFDataProcessingException else take cnt x | x<-rslt]--- -- count how many columns are added to sql data result for this nested object including the nested object id--- countQueriedSubFields :: [(String,[String],String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int--- countQueriedSubFields sodn soa (NestedObject alias name sobj ss sfs) tbls =---                         countQueriedSubFieldsHelper sodn soa sfs tbls $---                           countTableIds (last tbls) sodn--- countQueriedSubFieldsHelper :: [(String,[String],String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int -> Int--- countQueriedSubFieldsHelper sodn soa ((Left (ScalarType _ "__typename" _ _)):t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls acc--- countQueriedSubFieldsHelper sodn soa ((Left (ScalarType _ _ _ _)):t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls (acc+1)--- countQueriedSubFieldsHelper sodn soa ((Right (Left (NestedObject _ _ _ _ sfs))):t) tbls acc = ---     countQueriedSubFieldsHelper sodn soa t tbls $---       acc+(countQueriedSubFieldsHelper sodn soa sfs nxtTblSet $---         countTableIds (last nxtTblSet) sodn)---   where---     nxtTblSet = init tbls--- countQueriedSubFieldsHelper sodn soa ((Right (Right (InlinefragmentObject ifo sfs))):t) tbls acc---  | (isServerObjectTable (last tbls) ifo sodn soa)==True = countQueriedSubFieldsHelper sodn soa (sfs++t) tbls acc--- countQueriedSubFieldsHelper sodn soa (_:t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls acc--- countQueriedSubFieldsHelper _ _ [] _ acc = acc--- -- remove nested object columns from data row that is including nested object id--- removeNDataColumns :: Int -> [[Text]] -> [[Text]]--- removeNDataColumns 0 rslt = rslt--- removeNDataColumns (-1) _ = throw EOFDataProcessingException--- removeNDataColumns _ [[]] = throw EOFDataProcessingException  -- [[]]--- removeNDataColumns _ ([]:_) = throw EOFDataProcessingException--- removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt]-castJSType :: String -> Text -> JSValue-castJSType "Text" val = showJSON val-castJSType "ByteString" val = showJSON val-castJSType "Int" val = showJSON (Prelude.read $ unpack val :: Int)-castJSType "Double" val = showJSON (Prelude.read $ unpack val :: Double)-castJSType "Rational" val = showJSON (Prelude.read $ unpack val :: Double)-castJSType "Bool" val = showJSON (Prelude.read $ unpack val :: Int)-castJSType "Day" val = showJSON val-castJSType "TimeOfDay" val = showJSON val-castJSType "UTCTime" val = showJSON val-castJSType _ val = throw InvalidVariableTypeException--- countNOTables :: [(String,[String],String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int--- countNOTables sodn soa (NestedObject alias name sobj ss sfs) tbls = countSubfieldsTables sodn soa sfs tbls 1--- countSubfieldsTables :: [(String,[String],String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int -> Int--- countSubfieldsTables sodn soa ((Left _):t) tbls acc = countSubfieldsTables sodn soa t tbls acc--- countSubfieldsTables sodn soa ((Right (Left h)):t) tbls acc = countSubfieldsTables sodn soa t (updateTables foCount tbls) (acc+foCount)---   where---     foCount = countNOTables sodn soa h (init tbls)--- countSubfieldsTables sodn soa ((Right (Right (InlinefragmentObject ifo sfs))):t) tbls acc---  | (isServerObjectTable (last tbls) ifo sodn soa)==True = countSubfieldsTables sodn soa (sfs++t) tbls acc--- countSubfieldsTables sodn soa (_:t) tbls acc = countSubfieldsTables sodn soa t tbls acc--- countSubfieldsTables _ _ [] _ acc = acc--- updateTables :: Int -> [String] -> [String]--- updateTables 0 rlt = rlt--- updateTables _ [] = throw EOFDataProcessingException--- updateTables n lst---  | n<0 = throw InvalidArgumentException---  | otherwise = updateTables (n-1) ((init $ init lst)++[last lst])+processAggReturnedValues :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Int,Bool,String)]]] -> [[[[[a]]]]] -> String+processAggReturnedValues transFx sss sodn soa robjs tbls rlts = encodeStrict $ processAggReturnedValuesToJsonObject transFx sss sodn soa robjs tbls rlts+processAggReturnedValuesToJsonObject :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Int,Bool,String)]]] -> [[[[[a]]]]] -> JSObject (JSObject JSValue)+processAggReturnedValuesToJsonObject transFx sss sodn soa robjs tbls rlts = toJSObject [("data", toJSObject [processAggReturnedValueByRootObject transFx sss sodn soa a b c | (a,b,c) <- zip3 robjs tbls rlts])]+processAggReturnedValueByRootObject :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> RootObject -> [[(Int,Int,Bool,String)]] -> [[[[a]]]] -> (String, JSValue)+processAggReturnedValueByRootObject transFx sss sodn soa (NestedObject Nothing name sobj _ sfs) tbls rlts = (name, showJSONs $ packageAggSubFields transFx sss sodn soa sobj tbls sfs rlts)+processAggReturnedValueByRootObject transFx sss sodn soa (NestedObject (Just alias) name sobj _ sfs) tbls rlts = (alias, showJSONs $ packageAggSubFields transFx sss sodn soa sobj tbls sfs rlts)+packageAggSubFields :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Int,Bool,String)]] -> [Field] -> [[[[a]]]] -> [JSValue]+packageAggSubFields transFx sss sodn soa sobj tbls sfs rlts = packageAggSubFieldsForEveryRow transFx sss sodn soa sobj sfs grpdInstcByObjInst+  where+    dtaByInstCbntn = zip tbls rlts+    grpdInstcByObjInst = foldl' (\rlt (nInst,nDta)->if (thd4 $ head nInst)==False then+          ((init rlt)++[(last rlt)++[(nInst,(nDta,snd $ snd $ head $ last rlt))]])+        else+          rlt++[[(nInst,(nDta,countTableIds (fth4 $ head nInst) sodn))]]) [[(fst $ head dtaByInstCbntn,(snd $ head dtaByInstCbntn,countTableIds (fth4 $ head $ fst $ head dtaByInstCbntn) sodn))]] $ tail dtaByInstCbntn+packageAggSubFieldsForEveryRow :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [Field] -> [[([(Int,Int,Bool,String)],([[[a]]],Int))]] -> [JSValue]  -- result is root-instance/table/row/column+packageAggSubFieldsForEveryRow transFx sss sodn soa sobj (sf:sfs) dt = if null objWInst then [] else (++) objects $ packageAggSubFieldsForEveryRow transFx sss sodn soa sobj (sf:sfs) remIs+  where+    (_,_,_,_,isNull) = transFx+    objInstWRw = map (filter (not . null . head . fst . snd)) dt+    objWInst = filter (\nObj->(null nObj)==False) objInstWRw+    (nxtObjsRw,remIs) = foldl' (\(objRows,remRows) nObj->+      let (nObjRow,nObjRem) = foldl' (\(nInstRow,nInstRem) (tbls,(dSet,idC))->let (rowData,remData) = separateGqlRow isNull idC dSet in (nInstRow++[(tbls,rowData)],nInstRem++[(tbls,(remData,idC))])) ([],[]) nObj+      in (objRows++[unzip nObjRow],remRows++[nObjRem])) ([],[]) objWInst++    objects = foldl' (\rlt (nTbl,nDt)->rlt++({-if null nTbl {-no instance-} then [] else -}if (fst4 $ head $ head nTbl)<2 then+            map showJSON $ decodeTextToJSObj $ (\(toTxt,_,_,_,_)->toTxt) transFx $ head $ head $ head $ head $ nDt+          else+            [showJSON $ toJSObject $ makeOneGQLObjFrmAgg transFx sss sodn soa sobj nTbl (sf:sfs) nDt])) [] nxtObjsRw+packageAggSubFieldsForEveryRow transFx sss sodn soa sobj [] dt = []+decodeTextToJSObj :: Text -> [JSObject JSValue]+decodeTextToJSObj dta = case decode $ unpack dta of+  (Ok rlt) -> rlt :: [JSObject JSValue]+  _ -> throw ReadJsonException++makeOneGQLObjFrmAgg :: (Eq a) => ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Int,Bool,String)]] -> [Field] -> [[[[a]]]] -> [(String,JSValue)]+makeOneGQLObjFrmAgg _ _ _ _ _ [] _ _ = error "EOF data processing (source error)"  -- no instance combinations+makeOneGQLObjFrmAgg _ _ _ _ _ ([]:_) _ _ = error "EOF data processing (source error)"  -- no reference tables in first instance combination+makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) dat = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (fth4 $ head $ head tbls) sodn):(makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls b dat)+makeOneGQLObjFrmAgg (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) ((((i:j):k):l):m) = (getScalarFieldLabel $ ScalarType alias name trans arg, if isNull i then JSNull else castJSType (fx1,fx2,fx3,fx4,isNull) (findPrimitiveScalarTypeType (translateTableToObject (fth4 $ head $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObjFrmAgg (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls b (((j:k):l):m))++makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) ((j:k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs $ packageAggSubFields transFx sss sodn soa nso objTbls sfs objData):(makeOneGQLObjFrmAgg transFx sss sodn soa sobj remTbls b remData)+  where+    (objTbls,objData,remTbls,remData) = sepAggDataFrNstdObj tbls ((j:k):l)+makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) dat = if isServerObjectTable (fth4 $ head $ head tbls) ifo sodn soa then makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls (sfs++b) dat else makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls b dat+makeOneGQLObjFrmAgg _ _ _ _ _ _ [] ((([]:_):_):_) = []  -- no columns (in first variant and first query) and no fields (done)+makeOneGQLObjFrmAgg _ _ _ _ _ _ _ (([]:_):_) = []  -- no rows (no data)+makeOneGQLObjFrmAgg _ _ _ _ _ _ ((Right (Left _)):[]) ([]:_) = error "EOF data processing (source error)"  -- field and no queries (unusual)+makeOneGQLObjFrmAgg _ _ _ _ _ _ _ ([]:_) = []  -- no queries (no data)+makeOneGQLObjFrmAgg _ _ _ _ _ _ _ [] = []  -- no variants (unusual)+makeOneGQLObjFrmAgg _ _ _ _ _ _ [] _ = [] -- columns and no fields (done or error)+makeOneGQLObjFrmAgg _ _ _ _ _ _ ((Left _):_) ((([]:_):_):_) = error "EOF data processing (source error)"  -- field and no result columns++sepAggDataFrNstdObj :: [[(Int,Int,Bool,String)]] -> [[[[a]]]] -> ([[(Int,Int,Bool,String)]],[[[[a]]]],[[(Int,Int,Bool,String)]],[[[[a]]]])+sepAggDataFrNstdObj info dat = ([fstNObjMeta]++(concat nxtRowTbls),[fstNObjData]++(concat nxtRowData),[fstRemMeta]++(concat nxtRemTbls),[fstRemData]++(concat nxtRemData))+  where+    (nxtRowTbls,nxtRowData,nxtRemTbls,nxtRemData) = unzip4 $ map (\(instMt,instDt)->+      let+        nxtTblsInfo = tail instMt+        tNxtTblsInfo = tail nxtTblsInfo+        (_,objLvl,_,_) = head nxtTblsInfo+        nestedObjCount = foldr' (\(_,nlvl,_,_) rlt->if nlvl<=objLvl then 0 else rlt+1) 0 tNxtTblsInfo+        fQrydPos = foldr' (\(idx,(_,_,fst,_)) rlt->if fst then idx else rlt) ((length nxtTblsInfo)-1) $ zip [0..] nxtTblsInfo+        hasQrd = (<=) fQrydPos nestedObjCount+      in+        if hasQrd then+            ([tail instMt],[instDt],[],[])+          else+            ([],[],[(head instMt):(drop (nestedObjCount+1) $ tail instMt)],[instDt])) $ tail $ zip info dat+    fstInstInfo = head info+    fstInstDat = head dat+    (fstC,fstL,fstF,fstT) = head fstInstInfo+    nObjPlusTblsInfo = tail fstInstInfo+    nObjLvl = (+) fstL 1+    nstdObjsCount = foldr' (\(_,nlvl,_,_) rlt->if (==) nlvl nObjLvl then 1 else (+) rlt 1) 1 $ tail nObjPlusTblsInfo+    fstNObjMeta = take nstdObjsCount nObjPlusTblsInfo+    nObjPlusDat = tail $ fstInstDat+    fstNObjData = take nstdObjsCount nObjPlusDat+    fstRemMeta = (fstC,fstL,fstF,fstT):(drop nstdObjsCount nObjPlusTblsInfo)+    fstRemData = (head $ fstInstDat):(drop nstdObjsCount nObjPlusDat)

@@ -2,14 +2,13 @@   import Control.Exception (throw)-import Data.Foldable (foldl',foldr') import Model.ServerExceptions (-        QueryException(-            InvalidObjectException,-            RelationshipConfigurationException,-            NullArgumentException,-            InvalidArgumentException,-            InvalidScalarException+        ReferenceException(+            UnrecognisedObjectException,+            DisagreeingObjectFieldsException,+            UnrecognisedScalarException,+            UnrecognisedArgumentException,+            UnrecognisedRelationshipException         )     ) import Model.ServerObjectTypes (@@ -24,12 +23,10 @@         Argument,         Transformation     )+import Components.Util (fst3,fst4)   -- SCALAR FIELDS--- getScalarArgument :: ScalarType -> String--- getScalarArgument (ScalarType _ _ _ Nothing) = throw NullArgumentException--- getScalarArgument (ScalarType _ _ _ (Just arg)) = arg getScalarFieldLabel :: ScalarType -> String getScalarFieldLabel (ScalarType Nothing name _ _) = name getScalarFieldLabel (ScalarType (Just alias) _ _ _) = alias@@ -41,10 +38,10 @@ withSubSelection (NestedObject _ _ _ ss _) = (ss/=Nothing) getSubSelectionField :: NestedObject -> String getSubSelectionField (NestedObject _ _ _ (Just (ScalarType _ name _ _)) _) = name-getSubSelectionField _ = throw NullArgumentException+getSubSelectionField _ = error "Subselection request value is not found (source error)." getSubSelectionArgument :: NestedObject -> String getSubSelectionArgument (NestedObject _ _ _ (Just (ScalarType _ _ _ (Just arg))) _) = arg-getSubSelectionArgument _ = throw NullArgumentException+getSubSelectionArgument _ = error "Subselection request value is not found (source error)." getSubFields :: NestedObject -> SubFields getSubFields (NestedObject _ _ _ _ sf) = sf isSameNObjectReference :: NestedObject -> NestedObject -> Bool@@ -59,7 +56,7 @@ getIntersection :: Eq a => [[a]] -> [a] getIntersection [] = [] getIntersection ([]:t) = []-getIntersection ((h:t1):t2) = if foldr' (\x y -> (elem h x)&&y) True t2 then h:getIntersection (t1:t2) else getIntersection (t1:t2)+getIntersection ((h:t1):t2) = if all (elem h) t2 then h:getIntersection (t1:t2) else getIntersection (t1:t2)  -- REFERENCE SCHEMA {-@@ -69,18 +66,18 @@ readServerObject :: String -> [(String,[String])] -> [(String,[String],[String])] -> ServerObject readServerObject str ptv ((a,b,_):t) = if (elem str b)==True then (a :: ServerObject) else readServerObject str ptv t readServerObject str ((a,b):t) [] = if (elem str b)==True then (a :: ServerObject) else readServerObject str t []-readServerObject _ [] [] = throw InvalidObjectException+readServerObject _ [] [] = throw UnrecognisedObjectException readFieldObject :: String -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> ServerObject -> ServerObject readFieldObject str ((ptv,objs):rst) [] hld = if hld==ptv then     readServerObject str objs []   else readFieldObject str rst [] hld readFieldObject str ptvs ((pObj,_,pCldn):rst) hld = if hld==pObj then -    findSingularObject $ foldr (\cld y->(readFieldObject str ptvs [] cld):y) [] pCldn+    findSingularObject $ map (\cld->readFieldObject str ptvs [] cld) pCldn   else readFieldObject str ptvs rst hld-readFieldObject _ [] [] _ = throw InvalidObjectException+readFieldObject _ [] [] _ = throw UnrecognisedObjectException findSingularObject :: [String] -> String-findSingularObject (fst:rst) = if all ((==) fst) rst then fst else throw InvalidObjectException-findSingularObject [] = throw InvalidObjectException+findSingularObject (fst:rst) = if all ((==) fst) rst then fst else throw DisagreeingObjectFieldsException+findSingularObject [] = throw UnrecognisedObjectException -- INLINE-FRAGMENTS isSameIFObjectReference :: InlinefragmentObject -> InlinefragmentObject -> Bool isSameIFObjectReference (InlinefragmentObject obj1 _) (InlinefragmentObject obj2 _) = obj1==obj2@@ -90,13 +87,16 @@ isValidServerObjectChild _ _ [] = False -- SCHEMA HEIRARCHY isServerObjectTable :: String -> ServerObject -> [(String,[String],String)] -> [(String,[String],[String])] -> Bool-isServerObjectTable tbl soj sodn soa = foldr' (\(_,x) y->x==tbl||y) False $ translateServerObjectToDBName soj sodn soa +isServerObjectTable tbl soj sodn soa = any ((==) tbl . snd) $ translateServerObjectToDBName soj sodn soa  translateTableToObject :: String -> [(String,[String],String)] -> String translateTableToObject tbl ((pObj,_,pTbl):rst) = if tbl==pTbl then pObj else translateTableToObject tbl rst-translateTableToObject _ [] = throw InvalidObjectException+translateTableToObject _ [] = error "Table not found in schema (source error)." countTableIds :: String -> [(String,[String],String)] -> Int-countTableIds tbl ((_,ids,ntbl):t) = if (tbl==ntbl) then length ids else countTableIds tbl t-countTableIds _ [] = throw InvalidObjectException+countTableIds tbl ((_,ids,ntbl):t) = if tbl==ntbl then length ids else countTableIds tbl t+countTableIds " " _ = 0+countTableIds _ [] = error "Table not found in schema (source error)."+fetchTableIds :: String -> [(String,[String],String)] -> [String]+fetchTableIds tbl ((_,ids,ntbl):t) = if tbl==ntbl then ids else fetchTableIds tbl t {- checking server type attributes -}@@ -104,41 +104,35 @@ -- this is used to check queries against valid subfields isValidServerObjectScalarField :: ServerObject -> String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool isValidServerObjectScalarField sobj name ((ptv,fds):t) []- | sobj==ptv = foldr' (\(n,_,_)y->(name==n)||y) False fds+ | sobj==ptv = any ((==) name . fst3) fds  | otherwise = isValidServerObjectScalarField sobj name t []-isValidServerObjectScalarField sobj name pvs ((pnt,_,cdn):t) = if sobj==pnt then foldr' (\x y->(isValidServerObjectScalarField x name pvs [])&&y) True cdn else isValidServerObjectScalarField sobj name pvs t-isValidServerObjectScalarField _ _ [] _ = throw InvalidObjectException+isValidServerObjectScalarField sobj name pvs ((pnt,_,cdn):t) = if sobj==pnt then all (\x->isValidServerObjectScalarField x name pvs []) cdn else isValidServerObjectScalarField sobj name pvs t+isValidServerObjectScalarField _ _ [] _ = throw UnrecognisedObjectException isValidScalarTransformation :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool isValidScalarTransformation _ _ Nothing _ _ _ = True-isValidScalarTransformation sobj name (Just trans) arg ((ptv,fds):t) []- | sobj==ptv = findAndCheckScalarTransformation name trans arg fds- | otherwise = isValidScalarTransformation sobj name (Just trans) arg t []-isValidScalarTransformation sobj name trans arg pvs ((pnt,_,cdn):t) = if sobj==pnt then foldr' (\x y->(isValidScalarTransformation x name trans arg pvs [])&&y) True cdn else isValidScalarTransformation sobj name trans arg pvs t-isValidScalarTransformation _ _ _ _ [] _ = throw InvalidObjectException+isValidScalarTransformation sobj name (Just trans) arg ((ptv,fds):t) [] = if sobj==ptv then findAndCheckScalarTransformation name trans arg fds else isValidScalarTransformation sobj name (Just trans) arg t []+isValidScalarTransformation sobj name trans arg pvs ((pnt,_,cdn):t) = if sobj==pnt then all (\x->isValidScalarTransformation x name trans arg pvs []) cdn else isValidScalarTransformation sobj name trans arg pvs t+isValidScalarTransformation _ _ _ _ [] _ = throw UnrecognisedObjectException findAndCheckScalarTransformation :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> Bool findAndCheckScalarTransformation name trans arg ((n,_,args):t) = if name==n then findAndCheckTransformationOption trans arg args else findAndCheckScalarTransformation name trans arg t-findAndCheckScalarTransformation name trans arg [] = throw InvalidScalarException+findAndCheckScalarTransformation name trans arg [] = throw UnrecognisedScalarException findAndCheckTransformationOption :: String -> Argument -> [(String,[(String,String,String,String)])] -> Bool findAndCheckTransformationOption _ Nothing _ = True-findAndCheckTransformationOption trans (Just arg) ((name,opts):t) = if trans==name then foldr' (\(n,_,_,_) y->(arg==n)||y) False opts else findAndCheckTransformationOption trans (Just arg) t-findAndCheckTransformationOption _ _ [] = throw InvalidArgumentException--- you can create as many relationships as you want with your server...--- isValidServerObjectNestedObjectField :: ServerObject -> String -> [(String,[String])] -> [(String,[String],[String])] -> Bool--- isValidServerObjectNestedObjectField sobj name pvo ((so,_,cdn):t) = if sobj==so then foldl' (\y x->(isValidServerObjectNestedObjectField x name pvo [])&&y) True cdn else isValidServerObjectNestedObjectField sobj name pvo t--- isValidServerObjectNestedObjectField _ _ [] _ = throw InvalidObjectException--- isValidServerObjectNestedObjectField sobj name ((a,b):t) _ ---  | sobj==a = elem name b---  | otherwise = isValidServerObjectNestedObjectField sobj name t []+findAndCheckTransformationOption trans (Just arg) ((name,opts):t) = if trans==name then any ((==) arg . fst4) opts else findAndCheckTransformationOption trans (Just arg) t+findAndCheckTransformationOption _ _ [] = throw UnrecognisedArgumentException+-- INTERFACES -- split server object to sql query -- EFFECTS: returns the database table references for the server object. translateServerObjectToDBName :: ServerObject -> [(String,[String],String)] -> [(String,[String],[String])] -> [([String],String)]-translateServerObjectToDBName sobj ((a,b,c):t) []- | sobj==a = [(b,c)]- | otherwise = translateServerObjectToDBName sobj t []-translateServerObjectToDBName sobj pdn ((so,_,cdn):t) = if sobj==so then foldl' (\y x-> (translateServerObjectToDBName x pdn [])++y) [] cdn else translateServerObjectToDBName sobj pdn t-translateServerObjectToDBName _ [] _ = throw InvalidObjectException+translateServerObjectToDBName sobj ((a,b,c):t) [] = if sobj==a then [(b,c)] else translateServerObjectToDBName sobj t []+translateServerObjectToDBName sobj pdn ((so,_,cdn):t) = if sobj==so then concat $ map (\x->translateServerObjectToDBName x pdn []) cdn else translateServerObjectToDBName sobj pdn t+translateServerObjectToDBName _ [] _ = throw UnrecognisedObjectException getDBObjectRelationships :: String -> String -> [(String,String,[String])] -> [String]-getDBObjectRelationships from to ((a,b,c):t)- | from==a&&to==b = c- | otherwise = getDBObjectRelationships from to t-getDBObjectRelationships _ _ [] = throw RelationshipConfigurationException+getDBObjectRelationships from to ((a,b,c):t) = if from==a&&to==b then c else getDBObjectRelationships from to t+getDBObjectRelationships _ _ [] = throw UnrecognisedRelationshipException+isInterface :: [(String,[String],[String])] -> ServerObject -> Bool+isInterface ((so,_,_):t) sobj = if sobj==so then True else isInterface t so+isInterface [] _ = False+translateInterfaceToServerObjects :: [(String,[String],[String])] -> ServerObject -> [String]+translateInterfaceToServerObjects ((so,_,cdn):t) sobj = if sobj==so then cdn else translateInterfaceToServerObjects t sobj+translateInterfaceToServerObjects _ _ = throw UnrecognisedObjectException

@@ -0,0 +1,124 @@+module Components.ObjectHandlers.ServerObjectInspector (checkObjectsAttributes,replaceObjectsVariables,flagOneWay) where+++import Control.Exception (throw)+import Data.Foldable (foldl')+import Model.ServerObjectTypes (+        ServerObject,+        RootObject,+        ScalarType(..),+        Field,+        InlinefragmentObject(..),+        NestedObject(..),+        FlagNode(..)+    )+import Model.ServerExceptions (+        ReferenceException(+            UnrecognisedObjectException,+            UnrecognisedScalarException+        ),+        QueryException(MismatchedVariableTypeException)+    )+import Components.ObjectHandlers.ObjectsHandler (+        isValidServerObjectChild,+        isValidServerObjectScalarField,+        isValidScalarTransformation,+        isInterface,+        translateInterfaceToServerObjects+    )++-- check that all nested objects are with valid properties+checkObjectsAttributes :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> Bool+checkObjectsAttributes sss soa objs = all (\x->hasValidAttributes x sss soa) objs+hasValidAttributes :: NestedObject -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool+hasValidAttributes (NestedObject alias name sobject Nothing sfs) sss soa = isValidSubFields sobject sfs sss soa+hasValidAttributes (NestedObject alias name sobject (Just ss) sfs) sss soa = (isValidSubSelection sobject ss sss soa)&&isValidSubFields sobject sfs sss soa+isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool+isValidSubSelection obj (ScalarType alias name trans arg) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa+isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool+isValidSubFields _ [] _ _ = True  -- we should not get an empty query+isValidSubFields obj sfs sss soa = all (\x->isValidSubField obj x sss soa) sfs+isValidSubField :: ServerObject -> Field -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool+isValidSubField obj (Left (ScalarType alias "__typename" trans arg)) sss soa = True+isValidSubField obj (Left (ScalarType alias name trans arg)) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa+isValidSubField obj (Right (Left (NestedObject alias name sobject ss sfs))) sss soa = hasValidAttributes (NestedObject alias name sobject ss sfs) sss soa+isValidSubField obj (Right (Right (InlinefragmentObject ifo sfs))) sss soa = (isValidServerObjectChild obj ifo soa)&&isValidSubFields ifo sfs sss soa+-- replace variables with values and do type checking+-- ASSUME: variables are prefixed with $+replaceObjectsVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> [(String,String,String)] -> [RootObject]+replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs]+-- finish no dups in parse schema+replaceObjectVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> RootObject -> [(String,String,String)] -> RootObject+replaceObjectVariables sss soa (NestedObject alias name sobject Nothing sfs) vars = NestedObject alias name sobject Nothing [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]+replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans Nothing)) sfs) vars = NestedObject alias name sobject (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]+replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans (Just arg))) sfs) vars = NestedObject alias name sobject newScalar [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]+  where+    newScalar = Just $ ScalarType sAlias sName trans $ Just newValue+    newValue = if isVariable arg then replaceScalarVariable (getScalarTypeForVariableReplacement sobject sName sss soa) arg vars else arg++getScalarTypeForVariableReplacement :: ServerObject -> String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String+getScalarTypeForVariableReplacement obj st ((h,sts):rst) [] = if h==obj then findScalarType st sts else getScalarTypeForVariableReplacement obj st rst []+getScalarTypeForVariableReplacement obj st sss ((pnt,_,(fst:_)):rst) = if pnt==obj then getScalarTypeForVariableReplacement fst st sss [] else getScalarTypeForVariableReplacement obj st sss rst+getScalarTypeForVariableReplacement obj st sss ((pnt,_,[]):rst) = if pnt==obj then throw UnrecognisedObjectException else getScalarTypeForVariableReplacement obj st sss rst+getScalarTypeForVariableReplacement _ _ [] _ = throw UnrecognisedObjectException+findScalarType :: String -> [(String,String,[(String,[(String,String,String,String)])])] -> String+findScalarType st ((name,typ,_):rst) = if st==name then typ else findScalarType st rst+findScalarType _ [] = throw UnrecognisedScalarException++replaceScalarVariable :: String -> String -> [(String,String,String)] -> String+replaceScalarVariable typ arg ((vn,vt,vval):rst)+ | arg==vn&&typ==vt = vval+ | arg==vn = throw MismatchedVariableTypeException+ | otherwise = replaceScalarVariable typ arg rst+replaceScalarVariable _ _ [] = throw UnrecognisedScalarException++replaceSubfieldVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,String)] -> Field -> Field+replaceSubfieldVariables _ _ _ _ (Left (ScalarType alias name trans Nothing)) = Left $ ScalarType alias name trans Nothing+replaceSubfieldVariables sss soa sobj vars (Left (ScalarType alias name trans (Just arg))) = if not $ isVariable arg then Left $ ScalarType alias name trans $ Just arg else Left $ ScalarType alias name trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement sobj name sss soa) arg vars+replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj Nothing sfs))) = Right $ Left $ NestedObject alias name nsobj Nothing [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]+replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans Nothing)) sfs))) = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]+replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans (Just arg))) sfs))) = if (not $ isVariable arg) then Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just arg) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs] else Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement nsobj name sss soa) arg vars) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]+replaceSubfieldVariables sss soa sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = Right $ Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss soa ifsobj vars sf | sf<-sfs]+isVariable :: String -> Bool+isVariable = elem '$'++flagOneWay :: [(String,[String],[String])] -> [RootObject] -> [[FlagNode]]+flagOneWay soa robjs = map (\(NestedObject _ _ so _ sfs) -> flagOneWayByRootObj soa so sfs) robjs+flagOneWayByRootObj :: [(String,[String],[String])] -> ServerObject -> [Field] -> [FlagNode]+flagOneWayByRootObj soa so sfs = if isInterface soa so then [flagOneWayRootTable soa (FlagNode 0 []) [] nio sfs [] | nio<-translateInterfaceToServerObjects soa so] else [flagOneWayRootTable soa (FlagNode 0 []) [] so sfs []]+flagOneWayRootTable :: [(String,[String],[String])] -> FlagNode -> [Int] -> ServerObject -> [Field] -> [(ServerObject,[Field])] -> FlagNode+flagOneWayRootTable soa rsf idc so ((Left _):sfs) rem = flagOneWayRootTable soa rsf idc so sfs rem+flagOneWayRootTable soa rsf idc so ((Right (Left (NestedObject _ _ nso _ nsfs))):sfs) rem+  | flg && nNios > 1 = flagOneWayRootTable soa fRlt idc so sfs rem+  | flg && nNios > 0 = flagOneWayRootTable soa u1Rlt (rIdx:idc) (head nios) nsfs nrem+  | flg = flagOneWayRootTable soa u0Rlt idc so sfs rem -- TODO: make an empty query for interfaces without objects+  | otherwise = flagOneWayRootTable soa u1Rlt (rIdx:idc) nso nsfs nrem+ where+    nios = translateInterfaceToServerObjects soa nso+    nNios = length nios+    flg = isInterface soa nso+    u0Rlt = addNodeAndInc 0 rsf idc+    u1Rlt = addNodeAndInc 1 rsf idc+    rIdx = findNextIndex rsf idc+    fRlt = foldl' (\nRlt (nIdx,nObj)->let nU1Rlt = addNodeAndInc 1 nRlt idc in flagOneWayRootTable soa nU1Rlt (nIdx:idc) nObj nsfs []) rsf $ zip [rIdx..] nios+    nrem = (so,sfs):rem+flagOneWayRootTable soa rsf idc so ((Right (Right (InlinefragmentObject nso nsfs))):sfs) rem = if so==nso then flagOneWayRootTable soa rsf idc so (nsfs++sfs) rem else flagOneWayRootTable soa rsf idc so sfs rem+flagOneWayRootTable soa rsf idc so [] ((nso,nsfs):rem) = flagOneWayRootTable soa rsf (tail idc) nso nsfs rem+flagOneWayRootTable soa rsf idc so [] [] = rsf+addNodeAndInc :: Int -> FlagNode -> [Int] -> FlagNode+addNodeAndInc inc rsf idx = updateNodeValues nVal nTree idx+    where+        nTree = addNodeWithInc inc rsf idx+        nVal = findNewVal nTree idx+addNodeWithInc :: Int -> FlagNode -> [Int] -> FlagNode+addNodeWithInc inc (FlagNode val nds) [] = FlagNode (val+inc) (nds++[FlagNode 0 []])+addNodeWithInc inc (FlagNode val nds) (h:t) = FlagNode val [if nIdx/=h then nNode else addNodeWithInc inc nNode t | (nIdx,nNode)<-zip [0..] nds]+findNewVal :: FlagNode -> [Int] -> Int+findNewVal (FlagNode val _) [] = val+findNewVal (FlagNode _ nds) (h:t) = findNewVal ((!!) nds h) t+updateNodeValues :: Int -> FlagNode -> [Int] -> FlagNode+updateNodeValues nVal (FlagNode val nds) (h:t) = FlagNode (max nVal val) [if nIdx/=h then nNode else updateNodeValues nVal nNode t | (nIdx,nNode)<-zip [0..] nds]+updateNodeValues nVal (FlagNode val nds) [] = FlagNode (max nVal val) nds+findNextIndex :: FlagNode -> [Int] -> Int+findNextIndex (FlagNode _ nds) (h:t) = findNextIndex ((!!) nds h) t+findNextIndex (FlagNode _ nds) [] = length nds

@@ -9,10 +9,7 @@     InlinefragmentObject(..)   ) import Model.ServerExceptions (-    QueryException(-      DuplicateRootObjectsException,-      FailedObjectEqualityException-    )+    QueryException(DuplicateObjectsException)   ) import Components.ObjectHandlers.ObjectsHandler (     isSameNObjectReference,@@ -23,7 +20,6 @@  mergeDuplicatedRootObjects :: [RootObject] -> [RootObject] mergeDuplicatedRootObjects [] = []--- TODO: replace all check-then-process to single process... mergeDuplicatedRootObjects robjs = mergeDuplicatedRootObjectsHelper robjs [] mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject] mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences (rst++[mergeDuplicates h duplicates])@@ -36,7 +32,7 @@ separateDuplicatesAndDifferencesHelper :: RootObject -> [RootObject] -> [RootObject] -> [RootObject] -> ([RootObject],[RootObject]) separateDuplicatesAndDifferencesHelper robj (h:t) dup diff    | (isSameNObjectReference robj h)&&(isSameObjectSubSelection robj h) = separateDuplicatesAndDifferencesHelper robj t (h:dup) diff-   | (isSameNObjectReference robj h) = throw DuplicateRootObjectsException+   | (isSameNObjectReference robj h) = throw DuplicateObjectsException    | otherwise = separateDuplicatesAndDifferencesHelper robj t dup (h:diff) separateDuplicatesAndDifferencesHelper robj [] dup diff = (dup,diff) -- merge together valid (same reference and same subselection) RootObjects@@ -68,7 +64,7 @@ combineNestedObjectWithPresentHelper :: [Field] -> NestedObject -> [Field] -> [Field] combineNestedObjectWithPresentHelper ((Right (Left h)):t) no acc   | (isSameNObjectReference h no)&&(isSameObjectSubSelection h no) = ((Right $ Left $ mergeNObjects h no):t)++acc-  | isSameNObjectReference h no = throw DuplicateRootObjectsException+  | isSameNObjectReference h no = throw DuplicateObjectsException   | otherwise = combineNestedObjectWithPresentHelper t no ((Right $ Left h):acc) combineNestedObjectWithPresentHelper (h:t) no acc = combineNestedObjectWithPresentHelper t no (h:acc) combineNestedObjectWithPresentHelper [] no acc = acc++[Right $ Left no]@@ -80,7 +76,7 @@ combineInlinefragmentObjectWithPresent [] ifo = [Right $ Right ifo] -- one NestedObject that is same reference, same SubSelection and union set subfields with two NestedObjects that are same reference (alias, name, and ServerObject) and same SubSelection. mergeNObjects :: NestedObject -> NestedObject -> NestedObject-mergeNObjects (NestedObject alias1 name1 sobj1 ss1 sfs1) (NestedObject alias2 name2 sobj2 ss2 sfs2) = if alias1==alias2&&name1==name2&&sobj1==sobj2&&ss1==ss2 then NestedObject alias1 name1 sobj1 ss1 (compressSubFields (sfs1++sfs2)) else throw FailedObjectEqualityException+mergeNObjects (NestedObject alias1 name1 sobj1 ss1 sfs1) (NestedObject alias2 name2 sobj2 ss2 sfs2) = if alias1==alias2&&name1==name2&&sobj1==sobj2&&ss1==ss2 then NestedObject alias1 name1 sobj1 ss1 (compressSubFields (sfs1++sfs2)) else error "Requested object merge is for different things (source error)." -- one InlinefragmentObject that is same ServerObject and is union set subfields with two InlinefragmentObjects that are same reference (ServerObject) mergeIFObjects :: InlinefragmentObject -> InlinefragmentObject -> InlinefragmentObject-mergeIFObjects (InlinefragmentObject sobj1 sfs1) (InlinefragmentObject sobj2 sfs2) = if sobj1==sobj2 then InlinefragmentObject sobj1 (compressSubFields (sfs1++sfs2)) else throw FailedObjectEqualityException+mergeIFObjects (InlinefragmentObject sobj1 sfs1) (InlinefragmentObject sobj2 sfs2) = if sobj1==sobj2 then InlinefragmentObject sobj1 (compressSubFields (sfs1++sfs2)) else error "Requested object merge is for different things (source error)."

@@ -1,103 +0,0 @@-module Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables) where---import Control.Exception (throw)-import Data.Foldable (foldr')-import Model.ServerObjectTypes (-        ServerObject,-        RootObject,-        ScalarType(..),-        Field,-        InlinefragmentObject(..),-        NestedObject(..)-    )-import Model.ServerExceptions (-        QueryException(-            InvalidObjectException,-            InvalidScalarException,-            MismatchedVariableTypeException-        )-    )-import Components.ObjectHandlers.ObjectsHandler (-        isValidServerObjectChild,-        isValidServerObjectScalarField,-        isValidScalarTransformation-    )---- check that all nested objects are with valid properties-checkObjectsAttributes :: [RootObject] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool-checkObjectsAttributes objs sss soa = foldr' (\x y-> (hasValidAttributes x sss soa)&&y) True objs-hasValidAttributes :: NestedObject -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool-hasValidAttributes (NestedObject alias name sobject Nothing sfs) sss soa = isValidSubFields sobject sfs sss soa-hasValidAttributes (NestedObject alias name sobject (Just ss) sfs) sss soa = (isValidSubSelection sobject ss sss soa)&&isValidSubFields sobject sfs sss soa-isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool-isValidSubSelection obj (ScalarType alias name trans arg) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa-isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool-isValidSubFields _ [] _ _ = True  -- we should not get an empty query-isValidSubFields obj sfs sss soa = foldr' (\x y-> (isValidSubField obj x sss soa)&&y) True sfs-isValidSubField :: ServerObject -> Field -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool-isValidSubField obj (Left (ScalarType alias "__typename" trans arg)) sss soa = True-isValidSubField obj (Left (ScalarType alias name trans arg)) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa-isValidSubField obj (Right (Left (NestedObject alias name sobject ss sfs))) sss soa = hasValidAttributes (NestedObject alias name sobject ss sfs) sss soa-isValidSubField obj (Right (Right (InlinefragmentObject ifo sfs))) sss soa = (isValidServerObjectChild obj ifo soa)&&isValidSubFields ifo sfs sss soa--- replace variables with values and do type checking--- ASSUME: variables are prefixed with $-replaceObjectsVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> [(String,String,String)] -> [RootObject]-replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs]--- TODO--- check parent object subselection--- finish no dups in parse schema-replaceObjectVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> RootObject -> [(String,String,String)] -> RootObject-replaceObjectVariables sss soa (NestedObject alias name sobject Nothing sfs) vars = NestedObject alias name sobject Nothing [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]-replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans Nothing)) sfs) vars = NestedObject alias name sobject (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]-replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans (Just arg))) sfs) vars = NestedObject alias name sobject newScalar [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]-  where-    newScalar = Just $ ScalarType sAlias sName trans $ Just newValue-    newValue = if isVariable arg then replaceScalarVariable (getScalarTypeForVariableReplacement sobject sName sss soa) arg vars else arg--getScalarTypeForVariableReplacement :: ServerObject -> String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String-getScalarTypeForVariableReplacement obj st ((h,sts):rst) []- | h==obj = findScalarType st sts- | otherwise = getScalarTypeForVariableReplacement obj st rst []-getScalarTypeForVariableReplacement obj st sss ((pnt,_,(fst:_)):rst) = if pnt==obj then getScalarTypeForVariableReplacement fst st sss [] else getScalarTypeForVariableReplacement obj st sss rst-getScalarTypeForVariableReplacement obj st sss ((pnt,_,[]):rst) = if pnt==obj then throw InvalidObjectException else getScalarTypeForVariableReplacement obj st sss rst-getScalarTypeForVariableReplacement _ _ [] _ = throw InvalidObjectException-findScalarType :: String -> [(String,String,[(String,[(String,String,String,String)])])] -> String-findScalarType st ((name,typ,_):rst)- | st==name = typ- | otherwise = findScalarType st rst-findScalarType _ [] = throw InvalidScalarException---- findScalars :: [(String,[(String,String,[(String,[(String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,[(String,[(String,String,String)])])]--- findScalars [] _ _ = throw InvalidObjectException--- findScalars sss ((pnt,_,cld):t) sobj = if sobj==pnt then foldl' (\y x->) [] cld else findScalars sss t sobj--- findScalars ((name,sclrs):t) [] sobj = if sobj==name then sclrs else findScalars t [] sobj-replaceScalarVariable :: String -> String -> [(String,String,String)] -> String-replaceScalarVariable typ arg ((vn,vt,vval):rst)- | arg==vn&&typ==vt = vval- | arg==vn = throw MismatchedVariableTypeException- | otherwise = replaceScalarVariable typ arg rst-replaceScalarVariable _ _ [] = throw InvalidScalarException--- findScalarType :: [(String,String,[(String,[(String,String,String)])])] -> String -> String--- findScalarType [] _ = throw InvalidObjectScalarFieldException--- findScalarType ((name,typ,_):t) sname = if sname==name then typ else findScalarType t sname--- findReplacement :: String -> String -> [(String,String,String)] -> String--- findReplacement styp arg [] = throw InvalidVariableNameException--- findReplacement styp arg ((name,typ,val):t)---     | (name==arg)&&(typ==styp) = val---     | (name==arg) = throw MismatchedVariableTypeException---     | otherwise = findReplacement styp arg t--replaceSubfieldVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,String)] -> Field -> Field-replaceSubfieldVariables _ _ _ _ (Left (ScalarType alias name trans Nothing)) = Left $ ScalarType alias name trans Nothing-replaceSubfieldVariables sss soa sobj vars (Left (ScalarType alias name trans (Just arg)))- | (isVariable arg)==False = Left $ ScalarType alias name trans $ Just arg- | otherwise = Left $ ScalarType alias name trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement sobj name sss soa) arg vars-replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj Nothing sfs))) = Right $ Left $ NestedObject alias name nsobj Nothing [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]-replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans Nothing)) sfs))) = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]-replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans (Just arg))) sfs)))- | (isVariable arg)==False = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just arg) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]- | otherwise = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement nsobj name sss soa) arg vars) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]-replaceSubfieldVariables sss soa sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = Right $ Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss soa ifsobj vars sf | sf<-sfs]-isVariable :: String -> Bool-isVariable = elem '$'

@@ -6,13 +6,15 @@ import Data.Foldable (foldl') import Model.ServerExceptions (     QueryException(-      SyntaxException,-      InvalidScalarException,+      ParseFragmentException,+      EmptyQueryException,       InvalidObjectException,+      FindFragmentException,+      ReadDirectiveException,+      MismatchedVariableTypeException,       InvalidVariableNameException,-      EmptyQueryException,-      ParseFragmentException,-      MismatchedVariableTypeException+      InvalidScalarException,+      TransformationSyntaxException      )   ) import Model.ServerObjectTypes (@@ -64,9 +66,7 @@ validateBracketLocationQuery str = validateBracketLocationQueryHelper str 0 0 validateBracketLocationQueryHelper :: String -> Int -> Int -> Bool validateBracketLocationQueryHelper ('{':t) o c = validateBracketLocationQueryHelper t (o+1) c-validateBracketLocationQueryHelper ('}':t) o c- | o<=c = False- | otherwise = validateBracketLocationQueryHelper t o (c+1)+validateBracketLocationQueryHelper ('}':t) o c = if o<=c then False else validateBracketLocationQueryHelper t o (c+1) validateBracketLocationQueryHelper (_:t) o c = validateBracketLocationQueryHelper t o c validateBracketLocationQueryHelper "" x y = (x==y) validateNoEmptyBrackets :: String -> Bool@@ -77,14 +77,10 @@ validateNoEmptyBracketsHelper ('{':b) acc [] = validateNoEmptyBracketsHelper b [] [acc] validateNoEmptyBracketsHelper ('}':b) acc [] = False validateNoEmptyBracketsHelper (a:b) acc [] = validateNoEmptyBracketsHelper b (acc++[a]) []-validateNoEmptyBracketsHelper ('{':b) acc (i:j)- | (length acc)==0 = False- | otherwise = validateNoEmptyBracketsHelper b [] (acc:i:j)-validateNoEmptyBracketsHelper ('}':b) acc (i:j)- | (length acc)==0 = False- | otherwise = validateNoEmptyBracketsHelper b i j+validateNoEmptyBracketsHelper ('{':b) acc (i:j) = if (==) 0 $ length acc then False else validateNoEmptyBracketsHelper b [] (acc:i:j)+validateNoEmptyBracketsHelper ('}':b) acc (i:j) = if (==) 0 $ length acc then False else validateNoEmptyBracketsHelper b i j validateNoEmptyBracketsHelper (a:b) acc (i:j) = validateNoEmptyBracketsHelper b (acc++[a]) (i:j)-validateNoEmptyBracketsHelper "" acc nst = (length nst)<1+validateNoEmptyBracketsHelper "" acc nst = (>) 1 $ length nst   {-----Step 3. PARSING-----}@@ -94,7 +90,6 @@   where     (qry,fmts) = getQueryAndFragments str     fragments = parseFragments fmts svrobjs soa-    -- query = substituteFragments qry fragments svrobjs vars -- REQUIRES: curly braces are in correct order getQueryAndFragments :: String -> (String, String) getQueryAndFragments str = getQueryAndFragmentsHelper str 0 False "" ""@@ -135,22 +130,14 @@ createFragmentHelper ('$':t) l acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"$") True True True True rst1 rst2 svrobjs soa createFragmentHelper ('@':t) l acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"@") True True True True rst1 rst2 svrobjs soa createFragmentHelper (h:t) l acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++[h]) True True True True rst1 rst2 svrobjs soa---  | isValidIdentifierChar h = createFragmentHelper t l (acc++[h]) True True True True rst1 rst2 svrobjs soa---  | otherwise = throw ParseFragmentException createFragmentHelper (' ':t) l "" True False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True False a o rst1 rst2 svrobjs soa createFragmentHelper (' ':t) l acc True False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True a o acc rst2 svrobjs soa-createFragmentHelper (h:t) l acc True False a o rst1 rst2 svrobjs soa- | (isValidFragmentNameChar h)==False = throw ParseFragmentException- | otherwise = createFragmentHelper t l (acc++[h]) True False a o rst1 rst2 svrobjs soa+createFragmentHelper (h:t) l acc True False a o rst1 rst2 svrobjs soa = if (isValidFragmentNameChar h)==False then throw ParseFragmentException else createFragmentHelper t l (acc++[h]) True False a o rst1 rst2 svrobjs soa createFragmentHelper (' ':t) l "" True True True False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True False rst1 rst2 svrobjs soa-createFragmentHelper (h:t) l "" True True True False rst1 rst2 svrobjs soa-  | (fromEnum h)>=97||(fromEnum h)<=122 = createFragmentHelper t l [h] True True True False rst1 rst2 svrobjs soa-  | otherwise = throw ParseFragmentException+createFragmentHelper (h:t) l "" True True True False rst1 rst2 svrobjs soa = if (fromEnum h)>=97||(fromEnum h)<=122 then createFragmentHelper t l [h] True True True False rst1 rst2 svrobjs soa else throw ParseFragmentException createFragmentHelper (' ':t) l acc True True True False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True True rst1 acc svrobjs soa createFragmentHelper ('{':t) l acc True True True False rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) "" True True True True rst1 acc svrobjs soa-createFragmentHelper (h:t) l acc True True True False rst1 rst2 svrobjs soa-  | isValidIdentifierChar h = createFragmentHelper t l (acc++[h]) True True True False rst1 rst2 svrobjs soa-  | otherwise = throw ParseFragmentException+createFragmentHelper (h:t) l acc True True True False rst1 rst2 svrobjs soa = if isValidIdentifierChar h then createFragmentHelper t l (acc++[h]) True True True False rst1 rst2 svrobjs soa else throw ParseFragmentException createFragmentHelper ('f':t) l "" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "f" False n a o rst1 rst2 svrobjs soa createFragmentHelper ('r':t) l "f" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fr" False n a o rst1 rst2 svrobjs soa createFragmentHelper ('a':t) l "fr" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fra" False n a o rst1 rst2 svrobjs soa@@ -172,10 +159,10 @@  -- only names isValidFragmentNameChar :: Char -> Bool-isValidFragmentNameChar c = ((fromEnum c)>=65&&(fromEnum c)<=90)||((fromEnum c)>=97&&(fromEnum c)<=122)||((fromEnum c)>=48&&(fromEnum c)<=57)||((fromEnum c)==95)+isValidFragmentNameChar c = let num = fromEnum c in (num>=65&&num<=90)||(num>=97&&num<=122)||(num>=48&&num<=57)||(num==95) -- variables or names isValidIdentifierChar :: Char -> Bool-isValidIdentifierChar c = ((fromEnum c)>=65&&(fromEnum c)<=90)||((fromEnum c)>=97&&(fromEnum c)<=122)||((fromEnum c)>=48&&(fromEnum c)<=57)||((fromEnum c)==95)||((fromEnum c)==36)+isValidIdentifierChar c = let num = fromEnum c in (num>=65&&num<=90)||(num>=97&&num<=122)||(num>=48&&num<=57)||(num==95)||(num==36) -- call after infering types on nested objects -- get block in this scope splitSubject :: String -> String -> Int -> (String,String)@@ -185,7 +172,7 @@ splitSubject ('}':t) acc l = splitSubject t (acc++"}") (l-1) splitSubject (h:t) acc l = splitSubject t (acc++[h]) l splitSubject "" acc _ = (acc,"")--- -- substitute target string with replacement string within subject string...return result+-- substitute target string with replacement string within subject string...return result -- parse provided string to obtain query {- REQUIRES: Query is balanced and ordered brackets.@@ -202,22 +189,10 @@ composeObjectsHelper (_:t) l svrobjs sos soa vars fmts = composeObjectsHelper t l svrobjs sos soa vars fmts composeObjectsHelper "" _ _ _ _ _ _ = throw EmptyQueryException -- ...separate and determine operation--- TODO: implement operations--- determineOperation :: String -> (Operation,String)--- determineOperation str = determineOperationHelper str ""--- determineOperationHelper :: String -> String -> String--- determineOperationHelper [] acc = ((parseOperation acc1),[]) -- TODO: throw exception on empty query--- determineOperationHelper (h:t) acc---  | h=='{' = ((parseOperation acc), (removeLevel t))---  | otherwise = determineOperationHelper t (acc++[h])--- ...create several RootObjects from query blocks--- REQUIRES: brackets are balanced and ordered--- NOTE: only querying is first supported; mutations are later--- EFFECTS: passing block to createNestedObject where block is including opening and closing curly brackets separateRootObjects :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> [RootObject] separateRootObjects str svrobjs sos soa vars fmts = separateRootObjectsHelper str "" svrobjs sos soa vars fmts separateRootObjectsHelper :: String -> String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> [RootObject]-separateRootObjectsHelper ('{':t) acc svrobjs sos soa vars fmts = (((createNestedObject (acc++"{"++level) svrobjs sos soa vars fmts Nothing) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs sos soa vars fmts)+separateRootObjectsHelper ('{':t) acc svrobjs sos soa vars fmts = ((createNestedObject ((++) acc $ '{':level) svrobjs sos soa vars fmts Nothing) :: RootObject):separateRootObjectsHelper levelTail "" svrobjs sos soa vars fmts   where     (level,levelTail) = splitLevel t "" 0 separateRootObjectsHelper (',':t) acc svrobjs sos soa vars fmts = separateRootObjectsHelper t acc svrobjs sos soa vars fmts@@ -269,8 +244,8 @@ parseSubFields str svrobjs sos soa vars fmts sobj = parseSubFieldsHelper str "" "" svrobjs sos soa True vars fmts sobj parseSubFieldsHelper :: String -> String -> String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> Bool -> [(String,String,String)] -> [Fragment] -> ServerObject -> [Field] parseSubFieldsHelper ('{':t) acc1 acc2 svrobjs sos soa True vars fmts sobj-    | (length acc1)>0 = (Right (Left (createNestedObject (acc1++"{"++level) svrobjs sos soa vars fmts (Just sobj)) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj-    | (length acc2)>0 = (Right (Left (createNestedObject (acc2++"{"++level) svrobjs sos soa vars fmts (Just sobj)) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj    +    | (length acc1)>0 = (Right (Left (createNestedObject ((++) acc1 $ '{':level) svrobjs sos soa vars fmts (Just sobj)) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj+    | (length acc2)>0 = (Right (Left (createNestedObject ((++) acc2 $ '{':level) svrobjs sos soa vars fmts (Just sobj)) :: FieldObject) :: Field):parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj       where     (level,levelTail) = splitLevel t "" 0 parseSubFieldsHelper ('{':t) acc1 acc2 svrobjs sos soa _ vars fmts sobj@@ -280,9 +255,7 @@     (level,levelTail) = splitLevel t "" 0 parseSubFieldsHelper ('}':t) acc1 acc2 svrobjs sos soa inc vars fmts sobj = parseSubFieldsHelper t acc1 acc2 svrobjs sos soa inc vars fmts sobj  -- this character is removed when I pull a level parseSubFieldsHelper (':':t) acc1 acc2 svrobjs sos soa inc vars fmts sobj = parseSubFieldsHelper (removeLeadingSpaces t) (acc2++acc1++":") "" svrobjs sos soa inc vars fmts sobj-parseSubFieldsHelper (' ':t) acc1 acc2 svrobjs sos soa inc vars fmts sobj- | (length acc1)>0 = parseSubFieldsHelper t "" acc1 svrobjs sos soa inc vars fmts sobj- | otherwise = parseSubFieldsHelper t acc1 acc2 svrobjs sos soa inc vars fmts sobj+parseSubFieldsHelper (' ':t) acc1 acc2 svrobjs sos soa inc vars fmts sobj = if (length acc1)>0 then parseSubFieldsHelper t "" acc1 svrobjs sos soa inc vars fmts sobj else parseSubFieldsHelper t acc1 acc2 svrobjs sos soa inc vars fmts sobj parseSubFieldsHelper (',':t) acc1 acc2 svrobjs sos soa True vars fmts sobj  | (length acc1)>0 = (Left $ createScalarType acc1 :: Field):parseSubFieldsHelper t "" "" svrobjs sos soa True vars fmts sobj  | (length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t "" "" svrobjs sos soa True vars fmts sobj  -- if acc is not empty, I assume that acc1 is empty@@ -291,13 +264,11 @@  | (length acc2)>0 = parseSubFieldsHelper t "" "" svrobjs sos soa True vars fmts sobj  | otherwise = parseSubFieldsHelper t acc1 acc2 svrobjs sos soa inc vars fmts sobj parseSubFieldsHelper ('(':t) acc1 acc2 svrobjs sos soa inc vars fmts sobj-    | (length acc1)>0 = parseSubFieldsHelper selectTail (acc1++"("++subselect) "" svrobjs sos soa inc vars fmts sobj-    | (length acc2)>0 = parseSubFieldsHelper selectTail (acc2++"("++subselect) "" svrobjs sos soa inc vars fmts sobj+    | (length acc1)>0 = parseSubFieldsHelper selectTail ((++) acc1 $ '(':subselect) "" svrobjs sos soa inc vars fmts sobj+    | (length acc2)>0 = parseSubFieldsHelper selectTail ((++) acc2 $ '(':subselect) "" svrobjs sos soa inc vars fmts sobj   where     (subselect,selectTail) = getSubSelection t-parseSubFieldsHelper ('@':t) acc1 acc2 svrobjs sos soa _ vars fmts sobj-    | directive==True = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs sos soa True vars fmts sobj-    | otherwise = parseSubFieldsHelper directiveTail acc1 acc2 svrobjs sos soa False vars fmts sobj+parseSubFieldsHelper ('@':t) acc1 acc2 svrobjs sos soa _ vars fmts sobj = if directive then parseSubFieldsHelper directiveTail acc1 acc2 svrobjs sos soa True vars fmts sobj else parseSubFieldsHelper directiveTail acc1 acc2 svrobjs sos soa False vars fmts sobj   where     (directive,directiveTail) = checkDirective ('@':t) vars   parseSubFieldsHelper ('.':t) acc1 acc2 svrobjs sos soa True vars fmts sobj@@ -317,9 +288,7 @@     fContents = expandFragment fragmentName sobj fmts parseSubFieldsHelper (h:t) acc1 acc2 svrobjs sos soa True vars fmts sobj  | (length acc2)>0 = (Left $ createScalarType acc2 :: Field):parseSubFieldsHelper t (acc1++[h]) "" svrobjs sos soa True vars fmts sobj   -parseSubFieldsHelper (h:t) acc1 acc2 svrobjs sos soa inc vars fmts sobj- | (length acc2)>0 = parseSubFieldsHelper t (acc1++[h]) "" svrobjs sos soa True vars fmts sobj- | otherwise = parseSubFieldsHelper t (acc1++[h]) "" svrobjs sos soa inc vars fmts sobj+parseSubFieldsHelper (h:t) acc1 acc2 svrobjs sos soa inc vars fmts sobj = if (length acc2)>0 then parseSubFieldsHelper t (acc1++[h]) "" svrobjs sos soa True vars fmts sobj else parseSubFieldsHelper t (acc1++[h]) "" svrobjs sos soa inc vars fmts sobj parseSubFieldsHelper "" "" "" _ _ _ _ _ _ _ = [] parseSubFieldsHelper "" "" acc _ _ _ True _ _ _ = [(Left $ createScalarType acc) :: Field] parseSubFieldsHelper "" "" acc _ _ _ False _ _ _ = []@@ -344,14 +313,16 @@ checkInlinefragmentHelper (' ':t) "... " sobj obj = checkInlinefragmentHelper t "... " False "" checkInlinefragmentHelper ('o':t) "... " sobj obj = checkInlinefragmentHelper t "... o" False "" checkInlinefragmentHelper _ "... " _ _ = throw ParseFragmentException-checkInlinefragmentHelper ('n':t) "... o" sobj obj = checkInlinefragmentHelper t "... n" False ""+checkInlinefragmentHelper ('n':t) "... o" sobj obj = checkInlinefragmentHelper t "... on" False "" checkInlinefragmentHelper _ "... o" _ _ = throw ParseFragmentException checkInlinefragmentHelper (' ':t) "... on" sobj obj = checkInlinefragmentHelper t "... on " False "" checkInlinefragmentHelper _ "... on" _ _ = throw ParseFragmentException checkInlinefragmentHelper (' ':t) "... on " sobj obj = checkInlinefragmentHelper t "... on " False "" checkInlinefragmentHelper (h:t) "... on " sobj obj- | ((fromEnum h)>=97||(fromEnum h)<=122) = checkInlinefragmentHelper t ("... on "++[h]) False [h]- | otherwise = throw ParseFragmentException+  | (num>=97||num<=122) = checkInlinefragmentHelper t ("... on "++[h]) False [h]+  | otherwise = throw ParseFragmentException+ where+  num = fromEnum h checkInlinefragmentHelper (h:t) acc False obj  | isValidIdentifierChar h = checkInlinefragmentHelper t acc False (obj++[h]) checkInlinefragmentHelper (' ':t) acc False obj = checkInlinefragmentHelper t acc True obj@@ -383,7 +354,7 @@      expandFragment :: String -> ServerObject -> [Fragment] -> String expandFragment fnm sobj (h:t) = if (targetObject h)==sobj&&fnm==("..."++(name h)) then replacement h else expandFragment fnm sobj t-expandFragment _ _ [] = throw ParseFragmentException+expandFragment _ _ [] = throw FindFragmentException  removeLeadingSpaces :: String -> String removeLeadingSpaces (' ':t) = removeLeadingSpaces t@@ -412,7 +383,7 @@     | directive=="include"&&value=="false"=(False,tail)     | directive=="skip"&&value=="true"=(False,tail)     | directive=="skip"&&value=="false"=(True,tail)-    | otherwise = throw InvalidScalarException+    | otherwise = throw ReadDirectiveException   where     directive = toLowercase dir     value = if h=='$' then toLowercase $ getVariableValue vars (h:t) else toLowercase (h:t)@@ -436,11 +407,9 @@ toLowercase :: String -> String toLowercase str = [toLower c | c <- str] getVariableValue :: [(String,String,String)] -> String -> String-getVariableValue ((name,"Bool",val):t) var+getVariableValue ((name,"Boolean",val):t) var  | (name==var) = val-getVariableValue ((name,typ,val):t) var- | (name==var) = throw MismatchedVariableTypeException- | otherwise = getVariableValue t var+getVariableValue ((name,typ,val):t) var = if name==var then throw MismatchedVariableTypeException else getVariableValue t var getVariableValue [] _ = throw InvalidVariableNameException -- pull level and leave out closing brace. extractLevel :: String -> String@@ -452,33 +421,23 @@ extractLevelHelper ('}':t) l = '}':extractLevelHelper t (l-1) extractLevelHelper (h:t) l = h:extractLevelHelper t l extractLevelHelper "" _ = ""--- -- remove level and leave out closing brace--- removeLevel :: String -> String--- removeLevel [] = []--- removeLevel str = removeLevelHelper str 0--- removeLevelHelper :: String -> Int -> String--- removeLevelHelper [] _ = []--- removeLevelHelper (h:t) l---  | l<0 = h:t---  | h=='{' = removeLevelHelper t (l+1)---  | h=='}' = removeLevelHelper t (l-1)---  | otherwise = removeLevelHelper t l+-- remove level and leave out closing brace removeSpaces :: String -> String removeSpaces str = [x | x <- str, x/=' '] createScalarType :: String -> ScalarType+createScalarType (h:t) = ScalarType (parseAlias (h:t)) (parseName (h:t)) (parseTransformation (h:t)) (parseArgument (h:t)) createScalarType "" = throw InvalidScalarException-createScalarType str = ScalarType (parseAlias str) (parseName str) (parseTransformation str) (parseArgument str) parseTransformation :: String -> Transformation parseTransformation "" = Nothing :: Transformation parseTransformation str     | (elem '(' str)&&(elem ':' str) = (Just $ removeSideSpaces $ foldr (\x y -> if x==':' then "" else x:y) "" $ foldl' (\y x -> if x=='(' then "" else y++[x]) "" str) :: Transformation-    | (elem '(' str) = throw SyntaxException+    | (elem '(' str) = throw TransformationSyntaxException     | otherwise = Nothing :: Transformation parseArgument :: String -> Argument parseArgument "" = Nothing :: Argument parseArgument str     | (elem ')' str)&&(elem ':' str) = (Just $ removeSideSpaces $ foldr (\x y -> if x==')' then "" else x:y) "" $ foldl' (\y x -> if x==':' then "" else y++[x]) "" str) :: Argument-    | (elem ')' str) = throw SyntaxException+    | (elem ')' str) = throw TransformationSyntaxException     | otherwise = Nothing :: Argument removeSideSpaces :: String -> String removeSideSpaces str = foldl' (\y x -> if x==' '&&(length y)==0 then "" else y++[x]) "" $ foldr (\x y -> if x==' '&&(length y)==0 then "" else x:y) "" str

@@ -1,29 +1,36 @@ module Components.Parsers.ServerSchemaJsonParser (fetchArguments) where  import Control.Exception (throw)-import Data.Foldable (foldl',foldr') import Text.JSON (     JSValue(JSObject),     JSObject,-    Result(Ok,Error),+    Result(Ok),     valFromObj,     decode   ) import Model.ServerExceptions (-    QueryException(-      ImportSchemaServerNameException,-      ImportSchemaServerNameException,-      ImportSchemaServerNameException,-      ImportSchemaException,-      ImportSchemaChildrenException,-      ImportSchemaPseudonymsException,-      ImportSchemaScalarFieldsException,-      ImportSchemaDatabaseTablesException,-      ImportSchemaObjectFieldsException,-      ImportSchemaDatabaseRelationshipsException,-      ImportSchemaDuplicateException+    SchemaException(+      ReadSchemaFileException,+      SchemaDuplicateServerObjectException,+      SchemaDuplicateInterfaceException,+      ReadJsonObjectsException,+      ReadServerNameStringException,+      ReadScalarFieldException,+      ReadDatabaseTableException,+      ReadJsonStringException,+      ReadPseudonymsException,+      ReadInterfaceInstancesException,+      ReadDatabaseIdsException,+      ReadJsonStringListException,+      ReadDatabaseRelationshipsException,+      ScalarFieldDataTypeException,+      ReadDatabaseRelationshipsCardinalityException,+      PrimaryObjectNotFoundException,+      SchemaDuplicateException,+      InterfaceScalarTypesException     )   )+import Components.Util (snd3,fst3,fst4)   fetchArguments :: FilePath -> IO ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])@@ -33,16 +40,19 @@ parseSchema :: String -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])]) parseSchema str = parseHelper $ checkJSValueListValue (decode str :: Result (JSObject JSValue)) checkJSValueListValue :: Result (JSObject JSValue) -> (JSObject JSValue)-checkJSValueListValue (Error str) = throw ImportSchemaException checkJSValueListValue (Ok a) = a+checkJSValueListValue _ = throw ReadSchemaFileException parseHelper :: JSObject JSValue -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])],[(String,[String],[String])])-parseHelper json = if (isValidParentScalars soa sss)&&(isWithoutDups svrobjs sss sos sor soa) then (svrobjs,sss,sos,sdbn,sor,soa) else throw ImportSchemaChildrenException+parseHelper json +    | (isValidParentScalars soa sss)==False = throw InterfaceScalarTypesException+    | (isWithoutDups svrobjs sss sos sor soa)==False = throw SchemaDuplicateException+    | otherwise = (svrobjs,sss,sos,sdbn,sor,soa)   where-    (svrobjs,sss,sos,sdbn,sor) = parsePrimitivesIterator [] [] [] [] [] $ getObjects (valFromObj "PrimitiveObjects" json :: Result [JSObject JSValue])-    soa = parseParentsIterator [] $ getObjects (valFromObj "ParentalObjects" json :: Result [JSObject JSValue])+    (svrobjs,sss,sos,sdbn,sor) = parsePrimitivesIterator [] [] [] [] [] $ getObjects (valFromObj "PrimaryObjects" json :: Result [JSObject JSValue])+    soa = parseParentsIterator [] $ getObjects (valFromObj "Interfaces" json :: Result [JSObject JSValue]) parsePrimitivesIterator :: [(String,[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[(String,[String])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [JSObject JSValue] -> ([(String,[String])],[(String,[(String,String,[(String,[(String,String,String,String)])])])],[(String,[(String,[String])])],[(String,[String],String)],[(String,String,[String])]) parsePrimitivesIterator svrobjs sss sos sdbn sor [] = (svrobjs,sss,sos,sdbn,sor)-parsePrimitivesIterator svrobjs sss sos sdbn sor (obj:t) = if foldr' (\(prev,_,_) acc->(prev==name)||acc) False sdbn then throw ImportSchemaDuplicateException else parsePrimitivesIterator ((name,pseudonyms):svrobjs) ((name,scalars):sss) ((name,nestedobjects):sos) ((name,uids,table):sdbn) (sor++(processRelationships relationships)) t+parsePrimitivesIterator svrobjs sss sos sdbn sor (obj:t) = if any ((==) name . fst3) sdbn then throw SchemaDuplicateServerObjectException else parsePrimitivesIterator ((name,pseudonyms):svrobjs) ((name,scalars):sss) ((name,nestedobjects):sos) ((name,uids,table):sdbn) (sor++(processRelationships relationships)) t   where     name = getString (valFromObj "ServerName" obj :: Result String) 0     pseudonyms = getStringList (valFromObj "Pseudonyms" obj :: Result [String]) 0@@ -52,30 +62,30 @@     table = getString (valFromObj "DatabaseTable" obj :: Result String) 2     relationships = getListStringList (valFromObj "DatabaseRelationships" obj :: Result [[String]]) parseParentsIterator :: [(String,[String],[String])] -> [JSObject JSValue] -> [(String,[String],[String])]-parseParentsIterator soa (obj:t) = if foldr' (\(prev,_,_) acc->(prev==name)||acc) False soa then throw ImportSchemaDuplicateException else parseParentsIterator ((name,pseudonyms,children):soa) t+parseParentsIterator soa (obj:t) = if any ((==) name . fst3) soa then throw SchemaDuplicateInterfaceException else parseParentsIterator ((name,pseudonyms,children):soa) t   where     name = getString (valFromObj "ServerName" obj :: Result String) 0     pseudonyms = getStringList (valFromObj "Pseudonyms" obj :: Result [String]) 0     children = getStringList (valFromObj "ServerChildren" obj :: Result [String]) 1 parseParentsIterator soa [] = soa getObjects :: Result [JSObject JSValue] -> [JSObject JSValue]-getObjects (Error _) = throw ImportSchemaException getObjects (Ok objects) = objects+getObjects _ = throw ReadJsonObjectsException getString :: Result String -> Int -> String getString (Ok str) _ = str-getString (Error str) 0 = throw ImportSchemaServerNameException-getString (Error str) 1 = throw ImportSchemaScalarFieldsException-getString (Error str) 2 = throw ImportSchemaDatabaseTablesException-getString _ _ = throw ImportSchemaException+getString _ 0 = throw ReadServerNameStringException+getString _ 1 = throw ReadScalarFieldException+getString _ 2 = throw ReadDatabaseTableException+getString _ _ = throw ReadJsonStringException getStringList :: Result [String] -> Int -> [String] getStringList (Ok rlt) _ = rlt-getStringList _ 0 = throw ImportSchemaPseudonymsException-getStringList _ 1 = throw ImportSchemaChildrenException-getStringList _ 2 = throw ImportSchemaDatabaseTablesException-getStringList _ _ = throw ImportSchemaException+getStringList _ 0 = throw ReadPseudonymsException+getStringList _ 1 = throw ReadInterfaceInstancesException+getStringList _ 2 = throw ReadDatabaseIdsException+getStringList _ _ = throw ReadJsonStringListException getListStringList :: Result [[String]] -> [[String]]-getListStringList (Error str) = throw ImportSchemaDatabaseRelationshipsException getListStringList (Ok rlt) = rlt+getListStringList _ = throw ReadDatabaseRelationshipsException checkScalars :: Result [JSObject JSValue] -> [(String,String,[(String,[(String,String,String,String)])])] checkScalars = getScalars . getObjects getScalars :: [JSObject JSValue] -> [(String,String,[(String,[(String,String,String,String)])])]@@ -103,60 +113,54 @@ getObjectFields [] = [] getType :: Result String -> String getType (Ok "Text") = "Text"-getType (Ok "ByteString") = "ByteString"-getType (Ok "Int") = "Int" getType (Ok "Double") = "Double"-getType (Ok "Rational") = "Rational"-getType (Ok "Bool") = "Bool"-getType (Ok "Day") = "Day"-getType (Ok "TimeOfDay") = "TimeOfDay"-getType (Ok "UTCTime") = "UTCTime"--- getType (Error str) = throw ImportSchemaScalarFieldsException-getType _ = throw ImportSchemaScalarFieldsException+getType (Ok "Int64") = "Int64"+getType (Ok "Boolean") = "Boolean"+getType _ = throw ScalarFieldDataTypeException processRelationships :: [[String]] -> [(String,String,[String])]-processRelationships lst = foldr (\x y -> (getFirst x,getThird x, x):y) [] lst+processRelationships = map (\x->(getFirst x,getThird x, x)) getFirst :: [String] -> String getFirst (h:t) = h-getFirst _ = throw ImportSchemaException+getFirst _ = throw ReadDatabaseRelationshipsCardinalityException getThird :: [String] -> String getThird (h1:h2:h3:t) = h3-getThird _ = throw ImportSchemaException+getThird _ = throw ReadDatabaseRelationshipsCardinalityException -- no duplicated names in schema isWithoutDups :: [(String,[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[(String,[String])])] -> [(String,String,[String])] -> [(String,[String],[String])] -> Bool-isWithoutDups sobjs sss sos sor soa = (isNoDupsNames $ foldl' (++) [] ([x | (_,x)<-sobjs]++[x | (_,x,_)<-soa]))&&(isNoDupsScalars sss)&&(isNoDupsNestedObjects sos)&&(isNoDupsRelationships sor)+isWithoutDups sobjs sss sos sor soa = (isNoDupsNames $ concat $ (++) (map snd sobjs) $ map snd3 soa)&&(isNoDupsScalars sss)&&(isNoDupsNestedObjects sos)&&(isNoDupsRelationships sor) isNoDupsNames :: [String] -> Bool isNoDupsNames (nm:rst) = (elem nm rst==False)&&isNoDupsNames rst isNoDupsNames [] = True isNoDupsScalars :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool-isNoDupsScalars sss = foldr' (\(_,x) y->y&&isNoDupsScalarNames x) True sss+isNoDupsScalars = all (isNoDupsScalarNames . snd) isNoDupsScalarNames :: [(String,String,[(String,[(String,String,String,String)])])] -> Bool-isNoDupsScalarNames ((name,_,args):rst) = (foldr' (\(x,_,_) y->name/=x&&y) True rst)&&(isNoDupsScalarArguments args)&&isNoDupsScalarNames rst+isNoDupsScalarNames ((name,_,args):rst) = (all ((/=) name . fst3) rst)&&(isNoDupsScalarArguments args)&&isNoDupsScalarNames rst isNoDupsScalarNames [] = True isNoDupsScalarArguments :: [(String,[(String,String,String,String)])] -> Bool-isNoDupsScalarArguments ((name,opts):rst) = (foldr' (\(n,o) y->name/=n&&y&&isNoDupsArgumentOptions o) True rst)&&isNoDupsScalarArguments rst+isNoDupsScalarArguments ((name,opts):rst) = (all (\(n,o)->n/=name&&isNoDupsArgumentOptions o) rst)&&isNoDupsScalarArguments rst isNoDupsScalarArguments [] = True isNoDupsArgumentOptions :: [(String,String,String,String)] -> Bool-isNoDupsArgumentOptions ((name,_,_,_):rst) = (foldr' (\(n,_,_,_) y->name/=n&&y) True rst)&&isNoDupsArgumentOptions rst+isNoDupsArgumentOptions ((name,_,_,_):rst) = (all ((/=) name . fst4) rst)&&isNoDupsArgumentOptions rst isNoDupsArgumentOptions [] = True isNoDupsNestedObjects :: [(String,[(String,[String])])] -> Bool isNoDupsNestedObjects ((_,[]):rst) = isNoDupsNestedObjects rst isNoDupsNestedObjects ((obj,(no,nms):objs):rst) = noDupObj&&noDupNms&&isNoDupsNestedObjects ((obj,objs):rst)   where-    noDupObj = foldr' (\(x,_) y->x/=no&&y) True objs+    noDupObj = all ((/=) no . fst) objs     noDupNms = isNoDupsNames nms isNoDupsNestedObjects [] = True isNoDupsRelationships :: [(String,String,[String])] -> Bool-isNoDupsRelationships ((from,to,_):rst) = (foldr' (\(a,b,_) y->(from/=a||to/=b)&&y) True rst)&&isNoDupsRelationships rst+isNoDupsRelationships ((from,to,_):rst) = (all (\(a,b,_)->from/=a||to/=b) rst)&&isNoDupsRelationships rst isNoDupsRelationships [] = True -- shared scalars are same type isValidParentScalars :: [(String,[String],[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool-isValidParentScalars ((_,_,[]):t) sss = isValidParentScalars t sss+isValidParentScalars ((_,_,(h:nxt:cld)):t) sss = (isValidScalarsType (getPrimitiveScalars h sss) (nxt:cld) sss)&&isValidParentScalars t sss isValidParentScalars ((_,_,_:[]):t) sss = isValidParentScalars t sss-isValidParentScalars ((_,_,(h:cld)):t) sss = (isValidScalarsType (getPrimitiveScalars h sss) cld sss)&&isValidParentScalars t sss+isValidParentScalars ((_,_,[]):t) sss = isValidParentScalars t sss isValidParentScalars [] _ = True getPrimitiveScalars :: String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,String)]-getPrimitiveScalars name ((nm,st):t) = if name==nm then foldr' (\(n,tp,_) y->(n,tp):y) [] st else getPrimitiveScalars name t-getPrimitiveScalars _ [] = throw ImportSchemaChildrenException+getPrimitiveScalars name ((nm,st):t) = if name==nm then map (\(n,tp,_)->(n,tp)) st else getPrimitiveScalars name t+getPrimitiveScalars _ [] = throw PrimaryObjectNotFoundException isValidScalarsType :: [(String,String)] -> [String] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool-isValidScalarsType ((name,typ):t) cld sss = foldr' (\x y->foldr' (\(n,tp) b->((n==name&&typ==tp)||n/=name)&&y) True (getPrimitiveScalars x sss)) True cld+isValidScalarsType ((name,typ):t) cld sss = all (\chld->all (\(n,tp)->(n==name&&tp==typ)||n/=name) $ getPrimitiveScalars chld sss) cld isValidScalarsType [] _ _ = True

@@ -4,14 +4,15 @@ import Text.JSON (JSValue,JSObject,fromJSObject,Result(Ok,Error),encode,decode) import Data.List (foldl') import Model.ServerExceptions (-        QueryException(-            MissingVariableValueException,-            ReadVariablesException,-            EmptyQueryException,-            VariablesSyntaxException,-            InvalidVariableTypeException-        )+        VariableException(+          MissingVariableValueException,+          ReadVariablesJsonException,+          VariablesSyntaxException,+          InvalidVariableTypeException+        ),+        QueryException(EmptyQueryException)     )+import Components.Util (thd3)   -- from a variables string and query string to the query variables, the type, and the value@@ -21,13 +22,13 @@ filterToDesired :: [(String,String)] -> [(String,String,Maybe String)] -> [(String,String,String)] filterToDesired _ [] = [] filterToDesired [] tvar = if (anyMaybeMissingValues tvar)==True then throw MissingVariableValueException else getDefaultValues tvar-filterToDesired vvar tvars = [findVariableValue tvar vvar | tvar<-tvars]+filterToDesired vvar tvars = map (flip findVariableValue vvar)  tvars findVariableValue :: (String,String,Maybe String) -> [(String,String)] -> (String,String,String) findVariableValue (vname1,vtype,vval1) ((vname2,vval2):t) = if vname1==vname2 then (vname1,vtype,vval2) else findVariableValue (vname1,vtype,vval1) t findVariableValue (vname,vtype,Just vval) [] = (vname,vtype,vval :: String) findVariableValue (vname,vtype,Nothing) [] =  throw MissingVariableValueException anyMaybeMissingValues :: [(String,String,Maybe String)] -> Bool-anyMaybeMissingValues vars = foldr (\(nam,typ,val) y -> val==Nothing||y) False vars+anyMaybeMissingValues vars = any ((==) Nothing . thd3) vars getDefaultValues :: [(String,String,Maybe String)] -> [(String,String,String)] getDefaultValues vars = [(nam,typ,val) | (nam,typ,Just val)<-vars] -- from given variables argument to variable-values@@ -35,8 +36,8 @@ parseVariableValuePairs [] = [] parseVariableValuePairs vars = castValues $ fromJSObject $ checkVariables (decode vars :: Result (JSObject JSValue)) checkVariables :: Result (JSObject JSValue) -> JSObject JSValue-checkVariables (Error str) = throw ReadVariablesException checkVariables (Ok vars) = vars+checkVariables (Error _) = throw ReadVariablesJsonException castValues :: [(String,JSValue)] -> [(String,String)] castValues vars = [("$"++(removeQuotations name),encode val) | (name,val)<-vars] removeQuotations :: String -> String@@ -52,10 +53,12 @@   where     epilogue = getQueryEpilogue qry getQueryEpilogue :: String -> String-getQueryEpilogue (h:t) = if h=='{' then [] else h:(getQueryEpilogue t)+getQueryEpilogue ('{':t) = []+getQueryEpilogue (h:t) = h:(getQueryEpilogue t) getQueryEpilogue [] = throw EmptyQueryException removeLeadingSpaces :: String -> String-removeLeadingSpaces (h:t) = if h==' ' then removeLeadingSpaces t else (h:t)+removeLeadingSpaces (' ':t) = removeLeadingSpaces t+removeLeadingSpaces (h:t) = (h:t) separateVariables :: Bool -> String -> Bool -> String -> String -> String -> [(String,String,Maybe String)] separateVariables _ [] _ _ _ [] = []  -- no variables separateVariables _ var _ [] _ [] = throw VariablesSyntaxException  -- variable without type@@ -80,12 +83,7 @@ removeTailSpaces str = reverse $ removeLeadingSpaces $ reverse str isValidBaseType :: String -> Bool isValidBaseType "Text" = True-isValidBaseType "ByteString" = True-isValidBaseType "Int" = True+isValidBaseType "Int64" = True isValidBaseType "Double" = True-isValidBaseType "Rational" = True-isValidBaseType "Bool" = True-isValidBaseType "Day" = True-isValidBaseType "TimeOfDay" = True-isValidBaseType "UTCTime" = True+isValidBaseType "Boolean" = True isValidBaseType _ = False

@@ -1,4 +1,4 @@-module Components.QueryComposers.SQLQueryComposer (makeSqlQueries) where+module Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries) where  import Data.Map.Strict (fromList,Map,(!),insertWith) import Control.Exception (throw)@@ -10,16 +10,19 @@     Argument,     ServerObject,     ScalarType(..),-    InlinefragmentObject(..)+    InlinefragmentObject(..),+    NestedObject(..),+    Field,+    FlagNode(..)   ) import Model.ServerExceptions (-    QueryException (-      CreatingSqlQueryObjectsException,-      CreatingSqlQueryObjectFieldsException,-      InvalidObjectException,-      InvalidScalarException,-      RelationshipConfigurationException,-      InvalidArgumentException+    ReferenceException(+      RelationshipCardinalityException,+      RelationshipLinkageIdException,+      UnrecognisedObjectException,+      UnrecognisedArgumentException,+      UnrecognisedOptionException,+      UnrecognisedScalarException     )   ) import Components.ObjectHandlers.ObjectsHandler (@@ -31,74 +34,76 @@     getServerObject,     isServerObjectTable,     getSubFields,-    translateTableToObject+    translateTableToObject,+    getNestedObjectFieldLabel,+    getScalarFieldLabel,+    fetchTableIds   )  -makeSqlQueries :: [RootObject] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> ([[[(Int,Bool,String)]]],[[[String]]])-makeSqlQueries rojs sss sodn sor soa = unzip [makeSqlQuerySet sss sodn sor soa robj | robj<-rojs]-makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> ([[(Int,Bool,String)]],[[String]]) -- [([(Int,String)],[String])] ([[(Int,String)]],[[String]])-makeSqlQuerySet sss sodn sor soa obj = if (length dbNames)==1 then firstResult else (foldl' (\(tbls,qrs) (ntbls,nqrs) -> (tbls++ntbls,qrs++nqrs)) firstResult [(addSqlQueryFields (getSubFields obj) (fromList [(x,1)]) ("select "++(makeTableIdentifier xName xIds "")) "" (" from"++(makeSqlTablePhrase obj x 1)) (" order by "++(makeTableIdentifier xName xIds " asc")) ((x,1):[]) [] sss sodn sor soa 0 True [] [] [] []) | (xIds,x)<-(tail dbNames), let xName=x++(show 1)])+makeSqlQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [RootObject] -> ([[[(Int,Bool,String)]]],[[[String]]])+makeSqlQueries sss sodn sor soa rojs = unzip [makeSqlQuerySet sss sodn sor soa robj | robj<-rojs]+makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> ([[(Int,Bool,String)]],[[String]]) +makeSqlQuerySet sss sodn sor soa obj = (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys))                            where                              dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa                              (firstIds,firstTable) = head dbNames                              firstTableName = firstTable++(show 1)-                             firstResult = addSqlQueryFields (getSubFields obj) (fromList [(firstTable,1)]) ("select "++(makeTableIdentifier firstTableName firstIds "")) "" (" from"++(makeSqlTablePhrase obj firstTable 1)) (" order by "++(makeTableIdentifier firstTableName firstIds " asc")) (((firstTable,1):[])) [] sss sodn sor soa 0 True [] [] [] []+                             (fstTbls,fstQrys) = addSqlQueryFields (getSubFields obj) (fromList [(firstTable,1)]) ("SELECT "++(makeTableIdentifier firstTableName firstIds "")) "" (" FROM"++(makeSqlTablePhrase obj firstTable 1)) (((firstTable,1):[])) [] sss sodn sor soa 0 True [] [] [] []+                             (nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let xName=x++(show 1) in addSqlQueryFields (getSubFields obj) (fromList [(x,1)]) ("SELECT "++(makeTableIdentifier xName xIds "")) "" (" FROM"++(makeSqlTablePhrase obj x 1)) ((x,1):[]) [] sss sodn sor soa 0 True [] [] [] []) $ tail dbNames -- making table phrase when there is only one sql table makeSqlTablePhrase :: NestedObject -> String -> Int -> String-makeSqlTablePhrase obj name number = if (withSubSelection obj)==True then " (select * from "++name++" where "++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj)++") as "++name++numStr else " "++name++" as "++name++numStr+makeSqlTablePhrase obj name number = if (withSubSelection obj)==True then " (SELECT * FROM "++name++" WHERE "++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj)++") AS "++name++numStr else " "++name++" AS "++name++numStr   where     numStr = show number -- make queries for object of one table (most common is first - PCA example)-addSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Int -> Bool -> [(Int,Bool,String)] -> [(Int,Bool,String)] -> [(String,String,String,String)] -> [(String,String,String,String)] -> ([[(Int,Bool,String)]],[[String]]) -- [[((Int,String),String)]]-addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs-addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs-addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs+addSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Int -> Bool -> [(Int,Bool,String)] -> [(Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Bool,String)]],[[String]])+addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs+addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs+addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs   where     (prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss -- since only difference is table name, I should remove repeated computations by changing only name.-addSqlQueryFields ((Right (Left h)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs-    | tablesLen>1 = foldl' (\(info,qrs) (xIds,x)-> let-        newCounts=calcNewCounts ltable x counts sor-        xNum=(!) newCounts x-        xName=x++(show xNum)-        (nInfo,nQrs) = addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++(makeTransitions newCounts (getDBObjectRelationships ltable x sor) h)) (order++(makeTableIdentifier xName xIds " asc")) ((x,xNum):(ltable,ltableNo):names) emptiedFlds sss sodn sor soa newLvl True flsRcds [] [] []-      in-        (info++nInfo,qrs++nQrs)-      ) firstResult (tail tables)-    | tablesLen==1 = firstResult+addSqlQueryFields ((Right (Left h)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ((newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs)   where     tables = translateServerObjectToDBName (getServerObject h) sodn soa     tablesLen = length tables     (firstTableIds, firstTable) = head tables-    firstTableNewCounts = calcNewCounts ltable firstTable counts sor+    (firstTableNewCounts,transition) = makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable firstTable sor) h     firstTableNum = (!) firstTableNewCounts firstTable     firstTableName = firstTable++(show firstTableNum)     newLvl = lvl+1     objSfs = getSubFields h-    firstResult = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++(makeTransitions firstTableNewCounts (getDBObjectRelationships ltable firstTable sor) h)) (order++(makeTableIdentifier firstTableName firstTableIds " asc")) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa newLvl True (li++[(lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from,order)]++rqs) []-    emptiedFlds = ([]:[[] | _<-fields])-    flsRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) li)++[(lvl,False,ltable)]++(map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) ri)-addSqlQueryFields [] _ ids select from order ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++((lvl,True,ltbl):ri)],[lQrs++(((removeLastChar (ids++select))++from++(removeLastChar order)++";"):rQrs)])+    (fstTbls,fstQrys) = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa newLvl True (li++[(lvl,True,ltable)]) ri (lqs++[(ids,select,from)]) rqs+    (nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let+            (newCounts,transition)=makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable x sor) h+            xNum=(!) newCounts x+            xName=x++(show xNum)+            emptyFlds = ([]:[[] | _<-fields])+            flsLRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) li)++[(lvl,False,ltable)]+            flsRRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) ri)+          in+            addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa newLvl True flsLRcds flsRRcds [("","","") | _<-flsLRcds] [("","","") | _<-flsRRcds]) $ tail tables+addSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs])   where-    lQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-lqs]-    rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-rqs]-addSqlQueryFields [] counts ids select from order ((ltbl,_):b) (h:t) sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields h counts nids sel frm ord b t sss sodn sor soa nlvl nfst nli nri (init lqs) nrqs+    (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,True,ltbl):ri)) ((ids,select,from):rqs)+    lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs]+    rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]+addSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields h counts nids sel frm b t sss sodn sor soa nlvl nfst nli nri (init lqs) nrqs   where     (nlvl,nfst,_) = last li-    (nids,sel,frm,ord) = last lqs-    nrqs = (ids,select,from,order):rqs+    (nids,sel,frm) = last lqs+    nrqs = (ids,select,from):rqs     nli = init li     nri = (lvl,True,ltbl):ri-addSqlQueryFields _ _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ lvl False li ri _ rqs = ([li++((lvl,False,ltable):ri)],[rQrs])+addSqlQueryFields _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs])   where-    rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-rqs]-addSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs-    | isServerObjectTable ltable ifo sodn soa = addSqlQueryFields (sfs++t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs-addSqlQueryFields (_:t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs = addSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs-addSqlQueryFields _ _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ = throw CreatingSqlQueryObjectFieldsException -- fields without objects-calcNewCounts :: String -> String -> Map String Int -> [(String,String,[String])] -> Map String Int-calcNewCounts from to pcnt sor = foldl' (\y x-> insertWith (+) x 1 y) pcnt $ getNewTables $ getDBObjectRelationships from to sor+    (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,False,ltable):ri)) (("","",""):rqs)+    rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]+addSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs+    | isServerObjectTable ltable ifo sodn soa = addSqlQueryFields (sfs++t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs+addSqlQueryFields (_:t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs = addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs+addSqlQueryFields _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ = error "No objects are here for remaining fields (EOF source error)."  removeLastChar :: String -> String removeLastChar "" = "" removeLastChar str = init str@@ -107,39 +112,30 @@ getNewTables lnk = getNewTablesHelper (tail $ tail lnk) 0 getNewTablesHelper :: [String] -> Int -> [String] getNewTablesHelper (h:t) 0 = h:getNewTablesHelper (tail t) 3-getNewTablesHelper (h:t) idx-    | ((mod idx 3)==0) = h:getNewTablesHelper t (idx+1)-    | otherwise = getNewTablesHelper t (idx+1)+getNewTablesHelper (h:t) idx = if (==) 0 $ mod idx 3 then h:getNewTablesHelper t (idx+1) else getNewTablesHelper t (idx+1) getNewTablesHelper [] _ = []-makeTransitions :: Map String Int -> [String] -> NestedObject -> String-makeTransitions counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = " left join "++h5++" as "++h5++table5NumStr++" on "++(makeEqColumns (h1++(show $ (!) counts h1)) h2 (h5++table5NumStr) h6)++(completeTransition counts (h3:h4:h5:h6:h7:t) nobj)-  where-    table5NumStr = show $ (!) counts h5-makeTransitions counts (h1:h2:h3:h4:t) nobj = " left join "++(if (withSubSelection nobj)==True then "(select * from "++h3++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h3)++" as "++h3++table3NumStr++" on "++(makeEqColumns (h1++(show $ (!) counts h1)) h2 (h3++table3NumStr) h4)+makeTransitions :: String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String)+makeTransitions frm counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = completeTransition (" INNER JOIN "++h5++" AS "++nxtTbl++" ON "++(makeEqColumns frm (sepColString h2) nxtTbl (sepColString h6))) nxtTbl nxtCnt (h3:h4:h5:h6:h7:t) nobj   where-    table3NumStr = show $ (!) counts h3-makeTransitions _ _ _ = throw RelationshipConfigurationException-completeTransition :: Map String Int -> [String] -> NestedObject -> String-completeTransition counts (h1:h2:h3:h4:h5:h6:h7:h8:t) nobj = " left join "++h6++" as "++h6++table6NumStr++" on "++(makeEqColumns (h3++(show $ (!) counts h3)) h5 (h6++table6NumStr) h7)++(completeTransition counts (h1:h2:h6:h7:h8:t) nobj)+    nxtCnt = insertWith (+) h5 1 counts+    nxtTbl = (++) h5 $ show $ (!) nxtCnt h5+makeTransitions frm counts (h1:h2:h3:h4:_) nobj = (nxtCnt," INNER JOIN "++(if (withSubSelection nobj)==True then "(SELECT * FROM "++h3++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h3)++" AS "++nxtTbl++" ON "++(makeEqColumns frm (sepColString h2) nxtTbl (sepColString h4)))   where-    table6NumStr = show $ (!) counts h6-completeTransition counts (h1:h2:h3:h4:h5:[]) nobj = " left join "++(if (withSubSelection nobj)==True then "(select * from "++h1++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h1)++" as "++h1++table1NumStr++" on "++(makeEqColumns (h3++(show $ (!) counts h3)) h5 (h1++table1NumStr) h2)+    nxtCnt = insertWith (+) h3 1 counts+    nxtTbl = (++) h3 $ show $ (!) nxtCnt h3+makeTransitions _ _ _ _ = throw RelationshipCardinalityException+completeTransition :: String -> String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String)+completeTransition rlt prevTbl counts (h1:h2:h3:h4:h5:h6:h7:h8:t) nobj = completeTransition (rlt++" INNER JOIN "++h6++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h7))) nxtTbl nxtCnt (h1:h2:h6:h7:h8:t) nobj   where-    table1NumStr = show $ (!) counts h1-completeTransition counts _ _ = throw RelationshipConfigurationException-makeEqColumns :: String -> String -> String -> String -> String-makeEqColumns tb1 col1 tb2 col2 = if (elem ' ' col1)==False&&(elem ' ' col2)==False then tb1++"."++col1++"="++tb2++"."++col2 else makeEqColumnsHelper "" tb1 col1 tb2 col2-makeEqColumnsHelper :: String -> String -> String -> String -> String -> String-makeEqColumnsHelper rlt tb1 col1 tb2 col2-    | (elem ' ' col1)&&(elem ' ' col2)&&(length rlt)>0 = makeEqColumnsHelper (rlt++" and "++tb1++"."++fst++"="++tb2++"."++snd) tb1 rmd1 tb2 rmd2-    | (elem ' ' col1)&&(elem ' ' col2) = makeEqColumnsHelper (tb1++"."++fst++"="++tb2++"."++snd) tb1 rmd1 tb2 rmd2-    | (elem ' ' col1) = throw RelationshipConfigurationException-    | (elem ' ' col2) = throw RelationshipConfigurationException-    | (length rlt)>0 = rlt++" and "++tb1++"."++col1++"="++tb2++"."++col2-    | otherwise = tb1++"."++col1++"="++tb2++"."++col2+    nxtCnt = insertWith (+) h6 1 counts+    nxtTbl = (++) h6 $ show $ (!) nxtCnt h6+completeTransition rlt prevTbl counts (h1:h2:h3:h4:h5:[]) nobj = (nxtCnt, rlt++" INNER JOIN "++(if (withSubSelection nobj)==True then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h1)++" AS "++h1++table1NumStr++" ON "++(makeEqColumns prevTbl (sepColString h5) (h1++table1NumStr) (sepColString h2)))   where-    (fst, rmd1) = getFirstColumn col1-    (snd, rmd2) = getFirstColumn col2+    nxtCnt = insertWith (+) h1 1 counts+    table1NumStr = show $ (!) nxtCnt h1+completeTransition _ _ _ _ _ = throw RelationshipCardinalityException+makeEqColumns :: String -> [String] -> String -> [String] -> String+makeEqColumns tb1 col1 tb2 col2 = if length col1 /= length col2 then throw RelationshipLinkageIdException else init $ concat $ map (\(nxt1,nxt2)->tb1++"."++nxt1++"="++tb2++"."++nxt2++",") $ zip col1 col2 getFirstColumn :: String -> (String,String) getFirstColumn str = getFirstColumnHelper "" str getFirstColumnHelper :: String -> String -> (String,String)@@ -148,26 +144,178 @@ getFirstColumnHelper _ "" = ("","")  getPrimitiveScalarTypeArgumentOptions :: ServerObject -> String -> String -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> (String,String)-getPrimitiveScalarTypeArgumentOptions obj st trans arg ((h,sts):rst)- | h==obj = getScalarTypeArgumentsOptions st trans arg sts- | otherwise = getPrimitiveScalarTypeArgumentOptions obj st trans arg rst-getPrimitiveScalarTypeArgumentOptions _ _ _ _ [] = throw InvalidObjectException+getPrimitiveScalarTypeArgumentOptions obj st trans arg ((h,sts):rst) = if h==obj then getScalarTypeArgumentsOptions st trans arg sts else getPrimitiveScalarTypeArgumentOptions obj st trans arg rst+getPrimitiveScalarTypeArgumentOptions _ _ _ _ [] = throw UnrecognisedObjectException getScalarTypeArgumentsOptions :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> (String,String)-getScalarTypeArgumentsOptions st trans arg ((name,_,args):t)- | st==name = getArgumentOptions trans arg args- | otherwise = getScalarTypeArgumentsOptions st trans arg t-getScalarTypeArgumentsOptions _ _ _ [] = throw InvalidScalarException+getScalarTypeArgumentsOptions st trans arg ((name,_,args):t) = if st==name then getArgumentOptions trans arg args else getScalarTypeArgumentsOptions st trans arg t+getScalarTypeArgumentsOptions _ _ _ [] = throw UnrecognisedScalarException getArgumentOptions :: String -> Argument -> [(String,[(String,String,String,String)])] -> (String,String)-getArgumentOptions trans arg ((aname,opts):rst)- | trans==aname = getArgumentOption arg opts- | otherwise = getArgumentOptions trans arg rst-getArgumentOptions _ _ [] = throw InvalidArgumentException+getArgumentOptions trans arg ((aname,opts):rst) = if trans==aname then getArgumentOption arg opts else getArgumentOptions trans arg rst+getArgumentOptions _ _ [] = throw UnrecognisedArgumentException getArgumentOption :: Argument -> [(String,String,String,String)] -> (String,String) getArgumentOption Nothing ((_,_,prefix,suffix):_) = (prefix,suffix)-getArgumentOption (Just opt) ((name,_,prefix,suffix):rst)- | opt==name = (prefix,suffix)- | otherwise = getArgumentOption (Just opt) rst-getArgumentOption _ [] = throw InvalidArgumentException+getArgumentOption (Just opt) ((name,_,prefix,suffix):rst) = if opt==name then (prefix,suffix) else getArgumentOption (Just opt) rst+getArgumentOption _ [] = throw UnrecognisedOptionException makeTableIdentifier :: String -> [String] -> String -> String-makeTableIdentifier tbl (fid:ids) ins = foldl' (\y x->y++tbl++"."++x++ins++",") [] (fid:ids)+makeTableIdentifier tbl (fid:ids) ins = concat $ map (\x->tbl++"."++x++ins++",") (fid:ids) makeTableIdentifier _ [] _ = []++reverseNeighbourQueries :: [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))]+reverseNeighbourQueries qrys = let maxLvl = findMaxLevel qrys in rearrangeQueriesAtLevel maxLvl [] qrys+findMaxLevel :: [((Int,a),(String,String,String))] -> Int+findMaxLevel qrys = recordMaxLevel 0 qrys+recordMaxLevel :: Int -> [((Int,a),(String,String,String))] -> Int+recordMaxLevel rlt (((nxt,_),_):t) = recordMaxLevel (max rlt nxt) t+recordMaxLevel rlt _ = rlt+rearrangeQueriesAtLevel :: Int -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))]+rearrangeQueriesAtLevel 0 clc [] = clc+rearrangeQueriesAtLevel lvl clc (((nLvl,dat),qry):t) = if nLvl==lvl then+    rearrangeQueriesAtLevel lvl (clc++nOrd) rem+  else+    rearrangeQueriesAtLevel lvl (clc++[((nLvl,dat),qry)]) t+  where+    (nOrd,rem) = collectQueriesAndRearrange lvl [] (((nLvl,dat),qry):t)+rearrangeQueriesAtLevel lvl clc [] = rearrangeQueriesAtLevel (lvl-1) [] clc+collectQueriesAndRearrange :: Int -> [[((Int,a),(String,String,String))]] -> [((Int,a),(String,String,String))] -> ([((Int,a),(String,String,String))],[((Int,a),(String,String,String))])+collectQueriesAndRearrange lvl grps (((nLvl,dat),qry):t)+ | nLvl==lvl = collectQueriesAndRearrange lvl (grps++[[((nLvl,dat),qry)]]) t+ | nLvl>lvl = collectQueriesAndRearrange lvl ((init grps)++[(last grps)++[((nLvl,dat),qry)]]) t+ | otherwise = (concat $ reverse grps,((nLvl,dat),qry):t)+collectQueriesAndRearrange lvl grps [] = (concat $ reverse grps,[])++-- AGG QUERIES+makeSqlAggQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [[FlagNode]] -> [RootObject] -> ([[[(Int,Int,Bool,String)]]],[[[String]]])+makeSqlAggQueries sss sodn sor soa flgs rojs = unzip [makeSqlAggRootObjectQuerySet sss sodn sor soa oflgs robj | (oflgs,robj)<-zip flgs rojs]+makeSqlAggRootObjectQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [FlagNode] -> RootObject -> ([[(Int,Int,Bool,String)]],[[String]])+makeSqlAggRootObjectQuerySet sss sodn sor soa flgs obj = (concat tbls,concat qrys)+  where+    (tbls,qrys) = unzip $ map (\(FlagNode val nds,(tblIds,tbl))->let+      tblName=(++) tbl $ show 1+      sfs = getSubFields obj in if val<2 then ([[(val,0,True,tbl)]],[[makeSqlAggQuery sss sodn sor soa (fromList []) [(tbl,0)] "result0 AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(" (")) FROM "++tbl++" AS "++tbl++(show 0)) sfs [] ((if withSubSelection obj then " WHERE "++tbl++(show 0)++"."++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj) else "")++") SELECT "++(foldl' (++) "" ["0," | _<-tblIds])++"* FROM result0;")]]) else addAggSqlQueryFields sfs (fromList [(tbl,1)]) ("SELECT "++(makeTableIdentifier tblName tblIds "")) "" (" FROM"++(makeSqlTablePhrase obj tbl 1)) ((tbl,1):[]) [] sss sodn sor soa (FlagNode val nds) [] 0 True [] [] [] []) $ zip flgs dbNames+    dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa+makeSqlAggQuery :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Map String Int -> [(String,Int)] -> String -> String -> [Field] -> [(String,String,[Field])] -> String -> String+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end [] [] filterGroupSelect = "WITH "++(init def)++end++filterGroupSelect+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end [] ((ndef,nend,nsfs):rem) filterGroupSelect = makeSqlAggQuery sss sodn sor soa cnts lTbls ((init def)++end++ndef) nend nsfs rem filterGroupSelect+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType Nothing n Nothing _)):sfs) rem filterGroupSelect =+  makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++n++"',"++ltb++(show ltbNo)++"."++n++",") end sfs rem filterGroupSelect+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType (Just a) n Nothing _)):sfs) rem filterGroupSelect =+  makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++a++"',"++ltb++(show ltbNo)++"."++n++",") end sfs rem filterGroupSelect+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType a n (Just trans) arg)):sfs) rem filterGroupSelect =+  makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++(getScalarFieldLabel (ScalarType a n (Just trans) arg))++"',"++prefix++ltb++(show ltbNo)++"."++n++suffix++",") end sfs rem filterGroupSelect+ where+  (prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltb sodn) n trans arg sss+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Right (Left (NestedObject a n so ss nsfs))):sfs) rem filterGroupSelect =+ if length dbNames == 0 then+  makeSqlAggQuery sss sodn sor soa nCnts4 ((ltb,ltbNo):lTbls) (def++"'"++(getNestedObjectFieldLabel (NestedObject a n so ss nsfs))++"',JSON_ARRAY(),") end sfs rem filterGroupSelect+ else+  makeSqlAggQuery sss sodn sor soa nCnts4 ((tbl,tblNum):(ltb,ltbNo):lTbls) (nxtNOName++" AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++" AS "++rltName++","++idAndJoins) nsfs ((groupBy++"),"++def++"'"++(getNestedObjectFieldLabel (NestedObject a n so ss nsfs))++"',IFNULL(JSON("++nxtNOName++"."++rltName++"),JSON_ARRAY()),",end++" LEFT OUTER JOIN "++nxtNOName++" ON "++cnct,sfs):rem) filterGroupSelect+ where+  dbNames = translateServerObjectToDBName so sodn soa+  (ids,tbl) = head dbNames+  nxtNO = ltb++tbl+  nCnts = insertWith (+) nxtNO 1 cnts+  nxtNONum = (!) nCnts nxtNO+  nxtNOName = (++) nxtNO $ show nxtNONum+  nCnts2 = insertWith (+) "result" 1 nCnts+  rltNum = (!) nCnts2 "result"+  rltName = (++) "result" $ show rltNum+  nCnts3 = insertWith (+) tbl 1 (nCnts2)+  tblNum = (!) nCnts3 tbl+  (nCnts4,idAndJoins,groupBy,cnct) = makeAggLinks sodn ((++) tbl $ show tblNum) ((++) ltb $ show ltbNo) nxtNOName nCnts3 (getDBObjectRelationships tbl ltb sor) (NestedObject a n so ss nsfs)+makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Right (Right (InlinefragmentObject so nsfs))):sfs) rem filterGroupSelect =+ if translateTableToObject ltb sodn == so then+  makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end (nsfs++sfs) rem filterGroupSelect+ else+  makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end sfs rem filterGroupSelect++makeAggLinks :: [(String,[String],String)] -> String -> String -> String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String,String,String)+makeAggLinks sodn frmName toName aggName cnts (h1:h2:h3:h4:h5:h6:h7:t) nobj = completeAggLinks sodn (" FROM "++(if withSubSelection nobj then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++") AS "++frmName else h1++" AS "++frmName)++" INNER JOIN "++h5++" AS "++nxtTbl++" ON "++(makeEqColumns frmName (sepColString h2) nxtTbl (sepColString h6))) nxtTbl aggName toName frmName nxtCnt (h3:h4:h5:h6:h7:t)+  where+    nxtCnt = insertWith (+) h5 1 cnts+    nxtTbl = (++) h5 $ show $ (!) nxtCnt h5+makeAggLinks sodn frmName toName aggName cnts (h1:h2:h3:h4:_) nobj = (nxtCnt,uniqCols++" FROM "++(if withSubSelection nobj then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++") AS "++frmName else h1++" AS "++frmName)++" INNER JOIN "++h3++" AS "++nxtTbl++" ON "++(makeEqColumns frmName (sepColString h2) nxtTbl (sepColString h4))," GROUP BY "++uniqCols,makeEqColumns toName connIds aggName connIds)+  where+    nxtCnt = insertWith (+) h3 1 cnts+    nxtTbl = (++) h3 $ show $ (!) nxtCnt h3+    connIds = fetchTableIds h3 sodn+    uniqCols = listIdFields nxtTbl connIds+makeAggLinks _ _ _ _ _ _ _ = throw RelationshipCardinalityException+listIdFields :: String -> [String] -> String+listIdFields nm ids = tail $ concat $ map (\nxt->","++nm++"."++nxt) ids+completeAggLinks :: [(String,[String],String)] -> String -> String -> String -> String -> String -> Map String Int -> [String] -> (Map String Int,String,String,String)+completeAggLinks sodn rlt prevTbl aggName toName frmName counts (h1:h2:h3:h4:h5:h6:h7:h8:t) = completeAggLinks sodn (rlt++" INNER JOIN "++h6++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h7))) nxtTbl aggName toName frmName nxtCnt (h1:h2:h6:h7:h8:t)+  where+    nxtCnt = insertWith (+) h6 1 counts+    nxtTbl = (++) h6 $ show $ (!) nxtCnt h6+completeAggLinks sodn rlt prevTbl aggName toName frmName counts (h1:h2:h3:h4:h5:[]) = (nxtCnt,uniqCols++rlt++" INNER JOIN "++h1++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h2))," GROUP BY "++uniqCols,makeEqColumns toName connIds aggName connIds)+  where+    nxtCnt = insertWith (+) h1 1 counts+    nxtTbl = (++) h1 $ show $ (!) nxtCnt h1+    connIds = fetchTableIds h1 sodn+    uniqCols = listIdFields nxtTbl connIds+completeAggLinks _ _ _ _ _ _ _ _ = throw RelationshipCardinalityException+sepColString :: String -> [String]+sepColString str = if elem ' ' str then foldl' (\(h:t) nChar->if nChar==' ' then ("":h:t) else ((h++[nChar]):t)) [""] str else [str]++addAggSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> FlagNode -> [FlagNode] -> Int -> Bool -> [(Int,Int,Bool,String)] -> [(Int,Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Int,Bool,String)]],[[String]]) +addAggSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs+addAggSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs+addAggSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs+  where+    (prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss+addAggSqlQueryFields ((Right (Left h)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val nds) retFlgs lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val (tail nds)) retFlgs lvl True li ((2,newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs)+  where+    tables = translateServerObjectToDBName (getServerObject h) sodn soa+    tablesLen = length tables+    (firstTableIds, firstTable) = head tables+    (firstTableNewCounts,transition) = makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable firstTable sor) h+    firstTableNum = (!) firstTableNewCounts firstTable+    firstTableName = (++) firstTable $ show firstTableNum+    newLvl = lvl+1+    objSfs = getSubFields h+    (fstTbls,fstQrys) = if firstNodeFlg<2 then+        addAggSqlQueryFields t firstTableNewCounts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa retNode retFlgs lvl True li ((firstNodeFlg,lvl+1,True,firstTable):ri) lqs (("","",aggQry):rqs)+      else+        addAggSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa (head nds) (retNode:retFlgs) newLvl True (li++[(val,lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from)]++rqs) []+      where+        aggQry = makeSqlAggQuery sss sodn sor soa firstTableNewCounts [(firstTable,firstTableNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids firstTableIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(drop 7 ids)++(listIdFields firstTableName (fetchTableIds firstTable sodn))++") SELECT * FROM result0")+        firstNodeFlg = (\(FlagNode val _)->val) (head nds)+        retNode = FlagNode val $ drop tablesLen nds+    (nxtTbls,nxtQrys) = unzip $ map (\((FlagNode nVal nNds),(xIds,x))->let+          (newCounts,transition)=makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable x sor) h+          xNum=(!) newCounts x+          xName=x++(show xNum)+          (nInfo,nQrs) = if nVal<2 then+              addAggSqlQueryFields [] counts ids select from ((ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode val []) emptyFlgs lvl False flsLRcds ((nVal,newLvl,True,x):flsRRcds) lStubQrys (("","",aggQry):rStubQrys)+            else+              addAggSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode nVal nNds) ((FlagNode val []):emptyFlgs) newLvl True (flsLRcds++[(val,lvl,False,ltable)]) flsRRcds lStubQrys rStubQrys+            where+              aggQry = makeSqlAggQuery sss sodn sor soa newCounts [(x,xNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids xIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(init $ drop 7 ids)++") SELECT * FROM result0")+              emptyFlds = ([]:[[] | _<-fields])+              emptyFlgs = [FlagNode sVal [] | (FlagNode sVal _)<-retFlgs]+              flsLRcds = (map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) li)+              flsRRcds = map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) ri+              lStubQrys = [("","","") | _<-flsLRcds]+              rStubQrys = [("","","") | _<-flsRRcds]+        in+          (nInfo,nQrs)) $ tail $ zip nds tables+addAggSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ (FlagNode val _) retFlgs lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs])+  where+    (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,True,ltbl):ri)) ((ids,select,from):rqs)+    lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs]+    rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]+addAggSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa (FlagNode val _) retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields h counts nids sel frm b t sss sodn sor soa (head retFlgs) (tail retFlgs) nlvl nfst nli nri (init lqs) nrqs+  where+    (_,nlvl,nfst,_) = last li+    (nids,sel,frm) = last lqs+    nrqs = (ids,select,from):rqs+    nli = init li+    nri = (val,lvl,True,ltbl):ri+addAggSqlQueryFields _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ (FlagNode val _) _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs])+  where+    (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,False,ltable):ri)) (("","",""):rqs)+    rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]+addAggSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs+    | isServerObjectTable ltable ifo sodn soa = addAggSqlQueryFields (sfs++t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs+addAggSqlQueryFields (_:t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs+addAggSqlQueryFields _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ _ _ = error "Cannot find object for fields (source error)."

@@ -0,0 +1,14 @@+module Components.Util where++fst3 :: (a,b,c) -> a+fst3 (val,_,_) = val+snd3 :: (a,b,c) -> b+snd3 (_,val,_) = val+thd3 :: (a,b,c) -> c+thd3 (_,_,val) = val+fst4 :: (a,b,c,d) -> a+fst4 (val,_,_,_) = val+thd4 :: (a,b,c,d) -> c+thd4 (_,_,val,_) = val+fth4 :: (a,b,c,d) -> d+fth4 (_,_,_,val) = val

@@ -1,6 +1,6 @@ {- | Module      : GraphQLdbi-Description : Here are methods to interpret your GraphQL-to-SQL query and process the Persistent style results+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@@ -9,602 +9,265 @@  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 your variable-to-value definitions. -When errors are encountered, this module is simply going to throw an uncaught Exception. The Exception name is some hint to where was the error encountered. More information is provided in the below function description.+When errors are encountered, this module is simply going to throw an uncaught Exception. The Exception name is some 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>.+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 mentioned repo.  -} module GraphQLdbi (     -- * Functions-    -- | Here is three methods to the package interpretation, validation, and formatting features.+    -- | Here is the methods for the query interpretation, validation, and formatting features.     module GraphQLdbi,     -- * Server exceptions-    -- | These are server exceptions to make error handling.+    -- | These are exceptions from the package to make error handling.     module Model.ServerExceptions     ) where  import Data.Text (Text)-import Control.Monad.IO.Class (liftIO,MonadIO())+import Data.Int (Int64) import Control.Exception (throw)+import Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries) import Components.Parsers.QueryParser (validateQuery,parseStringToObjects,processString)-import Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables)-import Components.QueryComposers.SQLQueryComposer (makeSqlQueries) import Components.Parsers.ServerSchemaJsonParser (fetchArguments)-import Components.ObjectHandlers.ServerObjectTrimmer (mergeDuplicatedRootObjects) import Components.Parsers.VariablesParser (parseVariables)-import Components.DataProcessors.ListDataProcessor (processReturnedValues)+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)+import Model.ServerObjectTypes (RootObject,SchemaSpecs,QueryData,AggQueryData)   {- |-   This function is to parse your schema. The return values are 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.+   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 before all the other function calls.     __Schema:__ -   The schema json file is formated as one json object to describe the GraphQL objects and the object heirarchy.-   Only "PrimitiveObjects" are valid descendants to "ParentalObjects".-   Only the shared object fields and shared scalar fields are parental object fields.-   If a parental object is a declared field from a primitive object, all descendants are supposed to be declared in database relationships.-   When declaring any primitive or parental object, the pseudonym is supposed to list all possible root object references. As a nested object, you should declare the names in the nested object field definitions in corresponding object definitions.-   Primitive objects are expected to not have all NULL unique id values, and they are otherwise removed from the result.+   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 declares every field with a space " " separation.-   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 schema associations as declaring more object-fields in the primitive objects.+   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, ByteString, Int, Double, Rational, Bool, Day, TimeOfDay, or UTCTime.+   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: -    * ImportSchemaException (if there is a problem with reading your schema)-    * ImportSchemaServerNameException (if there is a problem with reading your servername argument)-    * ImportSchemaPseudonymsException (if there is a problem with reading your pseudonyms list argument)-    * ImportSchemaScalarFieldsException (if there is a problem with reading your scalarfields list argument)-    * ImportSchemaObjectFieldsException (if there is a problem with reading your objectfields list argument)-    * ImportSchemaDatabaseTablesException (if there is a problem with reading your databasetables list argument)-    * ImportSchemaDatabaseRelationshipsException (if there is a problem with reading your databaserelationships list argument)-    * ImportSchemaDuplicateException (if two or more Server objects are sharing the same name)-+    * 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:__ -   Here is an example schema to look at formatting:+   This is the syntax for the schema file:     @     {-      "ParentalObjects":[-        {-          "ServerName":"Taxonomy",-          "Pseudonyms":[-            "taxonomy",-            "Taxonomy"-          ],-          "ServerChildren":[-            "Breed",-            "Species",-            "Family",-            "Genus"-          ]-        }+      "Interfaces":[+        ({+          "ServerName":SERVEROBJECTNAME,+          "Pseudonyms":[(String)+],+          "ServerChildren":[(SERVEROBJECTNAME)+]+        })*       ],       "PrimitiveObjects":[-        {-          "ServerName": "Person",-          "Pseudonyms": [-            "person",-            "Person"-          ],-          "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            },-            {-              "Name": "gender",-              "Type": "Int",-              "Arguments": [-                {-                  "Name": "as",-                  "Options": [-                    {-                      "Name": "MALEFEMALE",-                      "Type": "Text",-                      "Prefix": "CASE WHEN ",-                      "Suffix": "==1 THEN 'MALE' ELSE 'FEMALE' END"-                    }-                  ]-                }-              ]-            }-          ],-          "ObjectFields": [-            {-              "Names": [-                "pet"-              ],-              "ServerName": "Pet"-            },-            {-              "Names": [-                "breed"-              ],-              "ServerName": "Breed"-            },-            {-              "Names": [-                "species"-              ],-              "ServerName": "Species"-            },-            {-              "Names": [-                "genus"-              ],-              "ServerName": "Genus"-            },-            {-              "Names": [-                "family"-              ],-              "ServerName": "Family"-            },-            {-              "Names": [-                "taxonomy"   -              ],-              "ServerName": "Taxonomy"-            }-          ],-          "DatabaseTable": "person",-          "UniqueIds": [-            "id"-          ],-          "DatabaseRelationships": [-            ["person","id","pet","id","pet_ownership","owner_id","animal_id"],-            ["person","id","breed","id","pet_ownership","owner_id","animal_id","pet","id","id","pet_type","pet_id","breed_id"],-            ["person","id","species","id","pet_ownership","owner_id","animal_id","pet","id","id","pet_type","pet_id","breed_id","breed","id","species_id"],-            ["person","id","genus","id","pet_ownership","owner_id","animal_id","pet","id","id","pet_type","pet_id","breed_id","breed","id","species_id","species","id","genus_id"],-            ["person","id","family","id","pet_ownership","owner_id","animal_id","pet","id","id","pet_type","pet_id","breed_id","breed","id","species_id","species","id","genus_id","genus","id","family_id"]-          ]-        },-        {-          "ServerName": "Family",-          "Pseudonyms": [-            "Family",-            "family"-          ],-          "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            }-          ],-          "ObjectFields": [-            {-              "Names": [-                "genus"-              ],-              "ServerName": "Genus"-            },-            {-              "Names": [-                "species"-              ],-              "ServerName": "Species"-            },-            {-              "Names": [-                "breed"-              ],-              "ServerName": "Breed"-            },-            {-              "Names": [-                "pet"-              ],-              "ServerName": "Pet"-            },-            {-              "Names": [-                "person"-              ],-              "ServerName": "Person"-            }-          ],-          "DatabaseTable": "family",-          "UniqueIds": [-            "id"-          ],-          "DatabaseRelationships": [-            ["family","id","person","id","genus","family_id","id","species","genus_id","id","breed","species_id","id","pet_type","breed_id","pet_id","pet_ownership","animal_id","owner_id"],-            ["family","id","pet","id","genus","family_id","id","species","genus_id","id","breed","species_id","id","pet_type","breed_id","pet_id"],-            ["family","id","genus","family_id"],-            ["family","id","species","genus_id","genus","family_id","id"],-            ["family","id","breed","species_id","genus","family_id","id","species","genus_id","id"]-          ]-        },-        {-          "ServerName": "Genus",-          "Pseudonyms": [-            "Genus",-            "genus"-          ],-          "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            }-          ],-          "ObjectFields": [-            {-              "Names": [-                "family"-              ],-              "ServerName": "Family"-            },-            {-              "Names": [-                "species"-              ],-              "ServerName": "Species"-            },-            {-              "Names": [-                "breed"-              ],-              "ServerName": "Breed"-            },-            {-              "Names": [-                "pet"-              ],-              "ServerName": "Pet"-            },-            {-              "Names": [-                "person"-              ],-              "ServerName": "Person"-            }-          ],-          "DatabaseTable": "genus",-          "UniqueIds": [-            "id"-          ],-          "DatabaseRelationships": [-            ["genus","id","person","id","species","genus_id","id","breed","species_id","id","pet_type","breed_id","pet_id","pet_ownership","animal_id","owner_id"],-            ["genus","id","pet","id","species","genus_id","id","breed","species_id","id","pet_type","breed_id","pet_id"],-            ["genus","family_id","family","id"],-            ["genus","id","species","genus_id"],-            ["genus","id","breed","species_id","species","genus_id","id"]-          ]-        },-        {-          "ServerName": "Species",-          "Pseudonyms": [-            "Species",-            "species"-          ],-          "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            }-          ],-          "ObjectFields": [-            {-              "Names": [-                "family"-              ],-              "ServerName": "Family"-            },-            {-              "Names": [-                "genus"-              ],-              "ServerName": "Genus"-            },-            {-              "Names": [-                "breed"-              ],-              "ServerName": "Breed"-            },-            {-              "Names": [-                "pet"-              ],-              "ServerName": "Pet"-            },-            {-              "Names": [-                "person"-              ],-              "ServerName": "Person"-            }-          ],-          "DatabaseTable": "species",-          "UniqueIds": [-            "id"-          ],-          "DatabaseRelationships": [-            ["species","id","person","id","breed","species_id","id","pet_type","breed_id","pet_id","pet_ownership","animal_id","owner_id"],-            ["species","id","pet","id","breed","species_id","id","pet_type","breed_id","pet_id"],-            ["species","id","breed","species_id"],-            ["species","genus_id","genus","id"],-            ["species","id","family","genus_id","genus","species_id","id"]-          ]-        },-        {-          "ServerName": "Breed",-          "Pseudonyms": [-            "Breed",-            "breed"-          ],-          "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            }-          ],-          "ObjectFields": [-            {-              "Names": [-                "family"-              ],-              "ServerName": "Family"-            },-            {-              "Names": [-                "genus"-              ],-              "ServerName": "Genus"-            },-            {-              "Names": [-                "species"-              ],-              "ServerName": "Species"-            },-            {-              "Names": [-                "pet"-              ],-              "ServerName": "Pet"-            },-            {-              "Names": [-                "person"-              ],-              "ServerName": "Person"-            }-          ],-          "DatabaseTable": "breed",-          "UniqueIds": [-            "id"-          ],-          "DatabaseRelationships": [-            ["breed","id","person","id","pet_type","breed_id","pet_id","pet_ownership","animal_id","owner_id"],-            ["breed","id","pet","id","pet_type","breed_id","pet_id"],-            ["breed","species_id","species","id"],-            ["breed","species_id","genus","id","species","id","genus_id"],-            ["breed","species_id","family","id","species","id","genus_id","genus","id","family_id"]-          ]-        },-        {-          "ServerName": "Pet",-          "Pseudonyms": [-            "pet",-            "Pet"-          ],+        ({+          "ServerName": SERVEROBJECTNAME,+          "Pseudonyms": [(String)+],           "ScalarFields": [-            {-              "Name": "id",-              "Type": "Int",-              "Arguments": []-            },-            {-              "Name": "name",-              "Type": "Text",-              "Arguments": []-            },-            {-              "Name": "gender",-              "Type": "Int",+            ({+              "Name": String,+              "Type": DATATYPE,               "Arguments": [-                {-                  "Name": "as",+                ({+                  "Name": String,                   "Options": [-                    {-                      "Name": "MALEFEMALE",-                      "Type": "Text",-                      "Prefix": "CASE WHEN ",-                      "Suffix": "==1 THEN 'MALE' ELSE 'FEMALE' END"-                    }+                    ({+                      "Name": String,+                      "Type": TYPE,+                      "Prefix": String,+                      "Suffix": String+                    })+                   ]-                }+                })*               ]-            }+            })*           ],           "ObjectFields": [-            {-              "Names": [-                "owner"-              ],-              "ServerName": "Person"-            },-            {-              "Names": [-                "breed"-              ],-              "ServerName": "Breed"-            },-            {-              "Names": [-                "species"-              ],-              "ServerName": "Species"-            },-            {-              "Names": [-                "genus"-              ],-              "ServerName": "Genus"-            },-            {-              "Names": [-                "family"-              ],-              "ServerName": "Family"-            },-            {-              "Names": [-                "taxonomy"-              ],-              "ServerName": "Taxonomy"-            }-          ],-          "DatabaseTable": "pet",-          "UniqueIds": [-            "id"+            ({+              "Names": [String],+              "ServerName": SERVEROBJECTNAME+            })*           ],+          "DatabaseTable": String,+          "UniqueIds": [String],           "DatabaseRelationships": [-            ["pet","id","person","id","pet_ownership","animal_id","owner_id"],-            ["pet","id","breed","id","pet_type","pet_id","breed_id"],-            ["pet","id","species","id","pet_type","pet_id","breed_id","breed","id","species_id"],-            ["pet","id","genus","id","pet_type","pet_id","breed_id","breed","id","species_id","species","id","genus_id"],-            ["pet","id","family","id","pet_type","pet_id","breed_id","breed","id","species_id","species","id","genus_id","genus","id","family_id"]+            ([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 possible chain from every PrimitiveObject to every other PrimitiveObject, the schema coverage is extended.+   When you add every PrimaryObject as a field to every PrimaryObject, the schema coverage is extended.     __Closing remark:__ -   As the last remark, I'll turn attention to a quote from specifications.+   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 you should make adjustments when you feel to evolve your server by making associations that are like simple arcs in a graph.+   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 :: (MonadIO m)-              => FilePath       -- ^ This is the path to schema json file-              -> m SchemaSpecs  -- ^ The return value is a monad for your schema data.-processSchema fp = do-          schema <- liftIO $ fetchArguments fp-          return schema+processSchema :: FilePath       -- ^ This is the path to schema json file+              -> IO SchemaSpecs -- ^ The return value is a monad for your schema data.+processSchema = fetchArguments {- |-  This function is to parse, validate, and interpret your 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.--  You also can use the above function to print and paste your schema data into your script file.+  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:__+  _Function return value:__ -  The returned values are one tuple to contain information to pass into your database interface and to later reuse in below data processing function. -  The tuple is (PackagedObjects,SQLQueries). The second tuple member is a collection of queries. -  Examples are found in this <https://github.com/jasonsychau/graphql-w-persistent repository page> to pass queries (and data) to your database.+  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: -  * SyntaxException (if there is a problem with the given GraphQL query syntax)-  * ParseFragmentException (if there is a problem with a Fragment syntax)-  * EmptyQueryException (if the query is left blank)-  * InvalidObjectException (if there is problem in nested object syntax, an object is not recognized, or server data is misinterpreted)-  * InvalidObjectSubFieldException (if a subfield is requested from nested object that is not having ownership of the subfield)-  * InvalidScalarException (if there is syntax error in listing scalar fields, or server data is misinterpreted)-  * NullArgumentException (if a transformation is set but no argument is given though we do not yet support transformations) -  * CreatingSqlQueryObjectFieldsException (if there are too many nested object subfields than nested objects to hold them or if there is a problem with the aligning of server object relationship argument - that's the fifth schema argument)-  * RelationshipConfigurationException (if the relationship schema fifth arugment is incorrect number of String values, if an unrecognized pairing is found, or if two table field cardinalities are not same)-  * FailedObjectEqualityException (if we could not match identical queries)-  * DuplicateRootObjectsException (if there is an overlapping query)--  * MissingVariableValueException (if we are missing variables in the variables-value string to the query)-  * InvalidVariableNameException (if we cannot find a variable in the query with given variables-value string)-  * MismatchedVariableTypeException (if query variable type is not matching object scalar type)-  * InvalidVariableTypeException (if variable type is invalid or missing)-  * ReadVariablesException (if the variables json string syntax is incorrect or was not correctly read)-  * VariablesSyntaxException (if the query variables declaration is invalid syntax)+  * 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+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 (svrobjs,sss,sos,sodn,sor,soa) qry vars =           let dvars = parseVariables vars qry               str = processString qry-              objs = if (validateQuery str)==True then (parseStringToObjects str svrobjs sos soa dvars) else throw SyntaxException+              objs = if validateQuery str then (parseStringToObjects str svrobjs sos soa dvars) else throw QuerySyntaxException               robjs = mergeDuplicatedRootObjects $ replaceObjectsVariables sss soa objs dvars-              (tbls,qrys) = if (checkObjectsAttributes robjs sss soa)==True then (makeSqlQueries robjs sss sodn sor soa) else (throw InvalidObjectSubfieldException)+              (tbls,qrys) = if checkObjectsAttributes sss soa robjs then (makeSqlQueries sss sodn sor soa robjs) else throw InvalidPropertiesException           in (zip robjs tbls,qrys) {- |-  After casting all database results to Text (examples are given in this repository <https://github.com/jasonsychau/graphql-w-persistent site>), you may use this function to make GraphQL data.+  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 (svrobjs,sss,sos,sodn,sor,soa) qry vars =+          let dvars = parseVariables vars qry+              str = processString qry+              objs = if validateQuery str then (parseStringToObjects str svrobjs sos soa dvars) else throw QuerySyntaxException+              robjs = mergeDuplicatedRootObjects $ replaceObjectsVariables sss soa objs dvars+              (tbls,qrys) = if checkObjectsAttributes sss soa robjs then (makeSqlAggQueries sss sodn sor soa (flagOneWay soa robjs) robjs) else throw InvalidPropertiesException+          in (zip robjs tbls,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 second argument is the package objects given from function processQueryString.-  -  The return result is a string to resemble a GraphQL return value.+  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>, -  __Formatting notes (IMPORTANT):__+  The fifth argument is a function to check if the database returned value is a null. This is for checking existence of values present. -  Nulls are expected as "Unexpected null". This is the Persistent default and important when processing ids to separate different results. One can translate nulls to "Unexpected null" when making Text types of query results. This is in the repository examples.+  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: -  * InvalidObjectException (when server data is misinterpreted or an unrecognized server object is met)-  * InvalidScalarException (when server data is misinterpreted)-  * EOFDataProcessingException (when the given data is shorter than expected in reference to the given serve objects)-  * InvalidArgumentException (when there is an internal argument error - you should not observe this)-  * InvalidVariableTypeException (when an unrecognized base data type is met)-  * InvalidObjectScalarFieldException (when an unrecognized object-scalar pair is met)+  * InvalidVariableTypeException (Variable type is not Text, Int64, Double, nor Boolean.)+  * ReadJsonException (Could not read json from database) -}-processQueryData :: SchemaSpecs   -- ^ This is the schema data from the first method+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.-                 -> [[[[[Text]]]]]  -- ^ This is the database query results value in the same order and after casting to Text values.+                 -> [[[[[a]]]]]   -- ^ This is the database query results value in the same order and after casting to Text values.                  -> String        -- ^ The return value is a string type to describe the GraphQL-organized return values.-processQueryData (_,sss,_,sodn,_,soa) cc dt =-          let (ro,tb) = unzip cc-          in processReturnedValues sss sodn soa ro tb dt+processQueryData toTxt toDbl toInt toBool isNull (_,sss,_,sodn,_,soa) qd dt =+          let (ro,tb) = unzip qd+          in processReturnedValues (toTxt,toDbl,toInt,toBool,isNull) sss sodn soa ro tb 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 and after casting to Text values.+                 -> String        -- ^ The return value is a string type to describe the GraphQL-organized return values.+processAggQueryData toTxt toDbl toInt toBool isNull (_,sss,_,sodn,_,soa) qd dt =+          let (ro,tb) = unzip qd+          in processAggReturnedValues (toTxt,toDbl,toInt,toBool,isNull) sss sodn soa ro tb dt

@@ -10,35 +10,57 @@ import Control.Exception  -data QueryException = SyntaxException |-                      ParseFragmentException |-                      EmptyQueryException | -                      InvalidObjectException | -                      InvalidScalarException |-                      NullArgumentException |-                      CreatingSqlQueryObjectFieldsException |-                      CreatingSqlQueryObjectsException |-                      EOFDataProcessingException |-                      RelationshipConfigurationException |-                      FailedObjectEqualityException |-                      DuplicateRootObjectsException |-                      ImportSchemaException |-                      ImportSchemaServerNameException |-                      ImportSchemaPseudonymsException |-                      ImportSchemaScalarFieldsException |-                      ImportSchemaObjectFieldsException |-                      ImportSchemaDatabaseTablesException |-                      ImportSchemaDatabaseRelationshipsException |-                      ImportSchemaChildrenException |-                      ImportSchemaDuplicateException |-                      MissingVariableValueException |-                      InvalidVariableNameException |-                      MismatchedVariableTypeException |-                      InvalidVariableTypeException |-                      ReadVariablesException |-                      VariablesSyntaxException |-                      InvalidArgumentException |-                      InvalidObjectSubfieldException+data SchemaException = ReadSchemaFileException+                     | SchemaDuplicateServerObjectException+                     | SchemaDuplicateInterfaceException+                     | ReadJsonObjectsException+                     | ReadServerNameStringException+                     | ReadScalarFieldException+                     | ReadDatabaseTableException+                     | ReadJsonStringException+                     | ReadPseudonymsException+                     | ReadInterfaceInstancesException+                     | ReadDatabaseIdsException+                     | ReadJsonStringListException+                     | ReadDatabaseRelationshipsException+                     | ScalarFieldDataTypeException+                     | ReadDatabaseRelationshipsCardinalityException+                     | PrimaryObjectNotFoundException+                     | SchemaDuplicateException+                     | InterfaceScalarTypesException   deriving Show+instance Exception SchemaException +data VariableException = MissingVariableValueException+                       | ReadVariablesJsonException+                       | VariablesSyntaxException+                       | InvalidVariableTypeException+  deriving Show+instance Exception VariableException++data QueryException = ParseFragmentException +                    | EmptyQueryException +                    | InvalidObjectException +                    | FindFragmentException +                    | ReadDirectiveException +                    | MismatchedVariableTypeException +                    | InvalidVariableNameException +                    | InvalidScalarException +                    | TransformationSyntaxException +                    | DuplicateObjectsException+                    | ReadJsonException+                    | QuerySyntaxException+  deriving Show instance Exception QueryException++data ReferenceException = RelationshipCardinalityException+                        | RelationshipLinkageIdException+                        | UnrecognisedObjectException+                        | UnrecognisedArgumentException+                        | UnrecognisedOptionException+                        | DisagreeingObjectFieldsException+                        | UnrecognisedScalarException+                        | UnrecognisedRelationshipException+                        | InvalidPropertiesException+  deriving Show+instance Exception ReferenceException

@@ -14,7 +14,7 @@  -- | NestedObjects are the general object type. They are found as RootObjects or as object Subfields. data NestedObject = NestedObject !Alias !Name !ServerObject !SubSelection !SubFields-                    deriving Show+                    deriving (Show,Eq) type Alias = Maybe String type ServerObject = String type SubSelection = Maybe ScalarType@@ -22,11 +22,10 @@ type Field = Either ScalarType FieldObject type FieldObject = Either NestedObject InlinefragmentObject data InlinefragmentObject = InlinefragmentObject !ServerObject !SubFields-                    deriving Show+                    deriving (Show,Eq)  -- | ScalarTypes are the other subfield type. They are also found at object attributes. data ScalarType = ScalarType !Alias !Name !Transformation !Argument-                -- deriving Eq                deriving (Show,Eq) type Transformation = Maybe String type Argument = Maybe String@@ -38,7 +37,9 @@     , targetObject :: ServerObject     , 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 QueryData = [(RootObject,[([(Int,Bool,String)])])]+type AggQueryData = [(RootObject,[[(Int,Int,Bool,String)]])]