graphql-w-persistent 0.7.0.1 → 0.8.0.0

raw patch · 13 files changed

+356/−319 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• graphql-w-persistent.cabal +1/−1
• src/Components/DataProcessors/ListDataProcessor.hs +141/−120
• src/Components/ObjectHandlers/ObjectsHandler.hs +25/−27
• src/Components/ObjectHandlers/ServerObjectTrimmer.hs +14/−14
• src/Components/ObjectHandlers/ServerObjectValidator.hs +6/−8
• src/Components/Parsers/QueryParser.hs +88/−93
• src/Components/Parsers/ServerSchemaJsonParser.hs +12/−14
• src/Components/Parsers/VariablesParser.hs +6/−6
• src/Components/QueryComposers/SQLQueryComposer.hs +56/−33
• src/GraphQLdbi.hs +2/−2
• src/Model/ServerExceptions.hs +0/−0
• src/Model/ServerObjectTypes.hs +1/−1

@@ -1,5 +1,9 @@ # Revision history for graphql-w-persistent +## 0.8.0.0 -- 2019-12-28++* reduce space footprint by querying objects individually and only once per reference+ ## 0.7.0.1 -- 2019-12-28  * fix exceptions

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.7.0.1+version:             0.8.0.0  -- A short (one-line) description of the package. synopsis:            GraphQL interface middleware for (SQL) databases.

@@ -5,14 +5,14 @@ import Control.Exception (throw) import Data.Foldable (foldl',foldr') import Model.ServerExceptions (-        QueryException(-            InvalidObjectException,-            InvalidScalarException,-            InvalidArgumentException,-            EOFDataProcessingException,-            InvalidVariableTypeException-        )+    QueryException(+      InvalidObjectException,+      InvalidScalarException,+      InvalidArgumentException,+      EOFDataProcessingException,+      InvalidVariableTypeException     )+  ) import Model.ServerObjectTypes (     NestedObject(..),     Field,@@ -24,86 +24,101 @@     InlinefragmentObject(..)   ) import Components.ObjectHandlers.ObjectsHandler (-      isServerObjectTable,-      getNestedObjectFieldLabel,-      getScalarFieldLabel,-      translateTableToObject,-      countTableIds+    isServerObjectTable,+    getNestedObjectFieldLabel,+    getScalarFieldLabel,+    translateTableToObject,+    countTableIds   )  --- with root objects we want one json representation of separate graphql results...-processReturnedValues :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[String]]] -> [[[[Text]]]] -> String+-- 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] -> [[[String]]] -> [[[[Text]]]] -> JSObject (JSObject JSValue)+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])]--- with qraphql query object and sql return data, we want json representation on graphql query results...-processReturnedValue :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> RootObject -> [[String]] -> [[[Text]]] -> (String, JSValue)+-- 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)--- with SubFields and data rows, we want json representation on qraphql query data-processSubFields :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[String]] -> [Field] -> [[[Text]]] -> [JSValue]-processSubFields _ _ _ _ _ _ [] = []-processSubFields _ _ _ _ _ [] _ = []--- are the query results from unique objects to make separate objects--- assume that if last table is same, fetchNextRow is same object instance-processSubFields sss sodn soa sobj tbls sfs rlts-    | (null $ foldl' (++) [] rlts)==True = []-    | sameTables&&(null object)==False = (showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls sfs remData)-    | sameTables = processSubFields sss sodn soa sobj tbls sfs remData-    | otherwise = [showJSON $ toJSObject x | x<-objects, (null x)==False]++(processSubFields sss sodn soa sobj tbls sfs remData)+-- 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)   where-    sameTables = foldr' (\x y->(last x)==(last $ head tbls)&&y) True tbls    -    object = makeOneGQLObject sss sodn soa sobj tbls sfs [fetchGraphQlRow x idC | (idC, x)<-zip idCounts rlts]-    -- different tables is possibly different result rows. I should not assume that they are same.-    notEmptyQueryResults = [(x,y,z) | (x,y,z)<-zip3 tbls rlts idCounts, null y==False]-    -- assume tbls are segmented from last table-    -- groupedData :: [[([String],[[Text]])]]-    groupedData = foldr (\(x,y) z -> if (null z)==True then [[(x,y)]] else if (last x)==(last $ fst $ head $ head z) then (((x,y):(head z)):(tail z)) else ([(x,y)]:z)) [] $ [(x,fetchGraphQlRow y z) | (x,y,z)<-notEmptyQueryResults]+    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 sfs y):z) [] labeledData-    remData = [removeDataRow x idC | (idC, x)<-zip idCounts rlts]-    idCounts = [countTableIds (last tbl) sodn | tbl<-tbls]--- assume all last elements are same in tbls--- assume all instances (ist) are same-makeOneGQLObject :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[String]] -> [Field] -> [[[Text]]] -> [(String,JSValue)]-makeOneGQLObject _ _ _ _ _ [] (([]:_):_) = []  -- done-makeOneGQLObject _ _ _ _ _ _ ([]:_) = []  -- no column data-makeOneGQLObject _ _ _ _ _ _ [] = []  -- no queries (unusual)-makeOneGQLObject _ _ _ _ _ [] _ = throw EOFDataProcessingException  -- columns and no fields+    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++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 sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):[]) (([]:_):_) = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):[]  -- field and no result columns--- makeOneGQLObject _ _ _ _ _ ((Left _):[]) (([]:_):_) = []  -- field and no result columns (unusual)--- makeOneGQLObject _ _ _ _ _ ((Right (Left _)):[]) (([]:_):_) = []  -- field and no result columns (unusual)-makeOneGQLObject sss sodn soa _ tbls (Right (Right (InlinefragmentObject ifo sfs)):[]) (([]:_):_)- | (isServerObjectTable (last $ head tbls) ifo sodn soa)==False = []  -- field and no result columns-makeOneGQLObject _ _ _ _ _ (_:[]) (([]:_):_) = throw EOFDataProcessingException  -- field and no result columns-makeOneGQLObject _ _ _ _ _ _ (([]:_):_) = throw EOFDataProcessingException  -- fields and no result columns-makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) (((i:j):k):l) = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):(makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l))  -- (((:fld):ist):qry)-makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) (((i:j):k):l) = (getScalarFieldLabel $ ScalarType alias name trans arg, castJSType (findPrimitiveScalarTypeType (translateTableToObject (last $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObject sss sodn soa sobj tbls b [removeNDataColumns 1 x | x<-(((i:j):k):l)])-makeOneGQLObject sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) (((i:j):k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs (processSubFields sss sodn soa nso nxtTbls sfs [pullNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)])):(makeOneGQLObject sss sodn soa sobj [updateTables (countNOTables sodn soa (NestedObject alias name nso ss sfs) x) x | x<-tbls] b [removeNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)])+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)   where-    nxtTbls = [init x | x<-tbls]-    nestedObjectFieldCounts = [countQueriedSubFields sodn soa (NestedObject alias name nso ss sfs) x | x<-nxtTbls]-makeOneGQLObject sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) (((i:j):k):l)- | (isServerObjectTable (last $ head tbls) ifo sodn soa)==True = makeOneGQLObject sss sodn soa sobj tbls (sfs++b) (((i:j):k):l)-makeOneGQLObject sss sodn soa sobj tbls (_:b) (((i:j):k):l) = makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l)+    (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 +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+ findPrimitiveScalarTypeType :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> String-findPrimitiveScalarTypeType _ _ _ _ [] = throw InvalidObjectException 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 findScalarTypeType :: String -> Transformation -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> String-findScalarTypeType _ _ _ [] = throw InvalidScalarException 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 findArgumentOptionType :: String -> Argument -> [(String,[(String,String,String,String)])] -> String-findArgumentOptionType _ _ [] = throw InvalidArgumentException findArgumentOptionType trans Nothing ((aname,[]):rst)  | trans==aname = throw InvalidArgumentException  | otherwise = findArgumentOptionType trans Nothing rst@@ -113,53 +128,59 @@ findArgumentOptionType trans (Just arg) ((aname,opts):rst)  | trans==aname = findOptionType arg opts  | otherwise = findArgumentOptionType trans (Just arg) rst+findArgumentOptionType _ _ [] = throw InvalidArgumentException findOptionType :: String -> [(String,String,String,String)] -> String-findOptionType _ [] = throw InvalidArgumentException findOptionType arg ((oname,typ,_,_):rst)  | arg==oname = typ  | otherwise = findOptionType arg rst+findOptionType _ [] = throw InvalidArgumentException -fetchGraphQlRow :: [[Text]] -> Int -> [[Text]]-fetchGraphQlRow rlts idRows = if (all ((==) (pack "Unexpected null"))-                                  firstIds) then [] else-                                  [drop idRows rltRow | rltRow<-rlts,-                                    (take idRows rltRow)==firstIds]+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 idRows $ head rlts-removeDataRow :: [[Text]] -> Int -> [[Text]]-removeDataRow rlts idRows = [rltRow | rltRow<-rlts, -                              (take idRows rltRow)/=(take idRows $ head rlts)]-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 _ _ [] _ acc = acc-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+                                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 --- 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]++-- 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@@ -171,20 +192,20 @@ 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 _ _ [] _ acc = acc-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-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])+-- 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])

@@ -67,63 +67,61 @@ - A valid argument is any string that is provided to reference database objects -} readServerObject :: String -> [(String,[String])] -> [(String,[String],[String])] -> ServerObject-readServerObject _ [] [] = throw InvalidObjectException-readServerObject str ((a,b):t) [] = if (elem str b)==True then (a :: ServerObject) else readServerObject str t [] 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 readFieldObject :: String -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> ServerObject -> ServerObject-readFieldObject _ [] [] _ = throw InvalidObjectException-readFieldObject str ptvs ((pObj,_,pCldn):rst) hld = if hld==pObj then -    findSingularObject $ foldr (\cld y->(readFieldObject str ptvs [] cld):y) [] pCldn-  else readFieldObject str ptvs rst hld 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+  else readFieldObject str ptvs rst hld+readFieldObject _ [] [] _ = throw InvalidObjectException findSingularObject :: [String] -> String-findSingularObject [] = throw InvalidObjectException findSingularObject (fst:rst) = if all ((==) fst) rst then fst else throw InvalidObjectException+findSingularObject [] = throw InvalidObjectException -- INLINE-FRAGMENTS isSameIFObjectReference :: InlinefragmentObject -> InlinefragmentObject -> Bool isSameIFObjectReference (InlinefragmentObject obj1 _) (InlinefragmentObject obj2 _) = obj1==obj2 -- SERVER OBJECTS isValidServerObjectChild :: ServerObject -> ServerObject -> [(String,[String],[String])] -> Bool-isValidServerObjectChild _ _ [] = False isValidServerObjectChild pnt cld ((so,_,cdn):t) = if pnt==so then elem cld cdn else isValidServerObjectChild pnt cld t+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  translateTableToObject :: String -> [(String,[String],String)] -> String-translateTableToObject _ [] = throw InvalidObjectException translateTableToObject tbl ((pObj,_,pTbl):rst) = if tbl==pTbl then pObj else translateTableToObject tbl rst+translateTableToObject _ [] = throw InvalidObjectException countTableIds :: String -> [(String,[String],String)] -> Int-countTableIds _ [] = throw InvalidObjectException countTableIds tbl ((_,ids,ntbl):t) = if (tbl==ntbl) then length ids else countTableIds tbl t+countTableIds _ [] = throw InvalidObjectException {- checking server type attributes -}--- EFFECT: returns exclusive list of valid fields that are found in the database table for each Server object +-- returns exclusive list of valid fields that are found in the database table for each Server object  -- 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 _ _ [] _ = throw InvalidObjectException-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 sobj name ((ptv,fds):t) _+isValidServerObjectScalarField sobj name ((ptv,fds):t) []  | sobj==ptv = foldr' (\(n,_,_)y->(name==n)||y) False fds  | otherwise = isValidServerObjectScalarField sobj name t []--- If no transformation is present, I allow different types for different children objects of the same scalar field.--- If there is a transformation, I require same type and transformation values since I cannot infer which child transformation before making queries while I can deduce types after queries with tables.+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 isValidScalarTransformation :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool isValidScalarTransformation _ _ Nothing _ _ _ = True-isValidScalarTransformation _ _ _ _ [] _ = throw InvalidObjectException-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 sobj name (Just trans) arg ((ptv,fds):t) _+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 findAndCheckScalarTransformation :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> Bool-findAndCheckScalarTransformation name trans arg [] = throw InvalidScalarException 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 findAndCheckTransformationOption :: String -> Argument -> [(String,[(String,String,String,String)])] -> Bool findAndCheckTransformationOption _ Nothing _ = True-findAndCheckTransformationOption _ _ [] = throw InvalidArgumentException 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@@ -134,13 +132,13 @@ -- 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 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) _+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 getDBObjectRelationships :: String -> String -> [(String,String,[String])] -> [String]-getDBObjectRelationships _ _ [] = throw RelationshipConfigurationException getDBObjectRelationships from to ((a,b,c):t)-    | from==a&&to==b = c-    | otherwise = getDBObjectRelationships from to t+ | from==a&&to==b = c+ | otherwise = getDBObjectRelationships from to t+getDBObjectRelationships _ _ [] = throw RelationshipConfigurationException

@@ -26,61 +26,61 @@ -- TODO: replace all check-then-process to single process... mergeDuplicatedRootObjects robjs = mergeDuplicatedRootObjectsHelper robjs [] mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject]-mergeDuplicatedRootObjectsHelper [] rst = rst mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences (rst++[mergeDuplicates h duplicates])                                            where (duplicates, differences) = separateDuplicatesAndDifferences h t--- we want two lists of duplicates and differences+mergeDuplicatedRootObjectsHelper [] rst = rst+-- two lists of duplicates and differences separateDuplicatesAndDifferences :: RootObject -> [RootObject] -> ([RootObject],[RootObject]) separateDuplicatesAndDifferences robj [] = ([],[]) separateDuplicatesAndDifferences robj lst = separateDuplicatesAndDifferencesHelper robj lst [] [] separateDuplicatesAndDifferencesHelper :: RootObject -> [RootObject] -> [RootObject] -> [RootObject] -> ([RootObject],[RootObject])-separateDuplicatesAndDifferencesHelper robj [] dup diff = (dup,diff) separateDuplicatesAndDifferencesHelper robj (h:t) dup diff    | (isSameNObjectReference robj h)&&(isSameObjectSubSelection robj h) = separateDuplicatesAndDifferencesHelper robj t (h:dup) diff    | (isSameNObjectReference robj h) = throw DuplicateRootObjectsException    | otherwise = separateDuplicatesAndDifferencesHelper robj t dup (h:diff)+separateDuplicatesAndDifferencesHelper robj [] dup diff = (dup,diff) -- merge together valid (same reference and same subselection) RootObjects -- ASSUME: all objects are same reference and subselection mergeDuplicates :: RootObject -> [RootObject] -> RootObject-mergeDuplicates robj [] = robj mergeDuplicates (NestedObject alias name sobj ss sf1) ((NestedObject _ _ _ _ sf2):t) = mergeDuplicates (NestedObject alias name sobj ss (compressSubFields (sf1++sf2))) t--- with a list of Fields, we want to merge duplicate Fields+mergeDuplicates robj [] = robj+-- from list of Fields to merged duplicate Fields compressSubFields :: [Field] -> [Field] compressSubFields [] = [] compressSubFields lst = compressSubFieldsHelper lst []--- We want a removed-duplicate set with a list of Fields, and empty list.+-- want a removed-duplicate set with a list of Fields, and empty list. compressSubFieldsHelper :: [Field] -> [Field] -> [Field]-compressSubFieldsHelper [] rst = rst compressSubFieldsHelper ((Left h):t) rst = compressSubFieldsHelper t (combineScalarTypeWithPresent rst h) compressSubFieldsHelper ((Right (Left h)):t) rst = compressSubFieldsHelper t (combineNestedObjectWithPresent rst h) compressSubFieldsHelper ((Right (Right h)):t) rst = compressSubFieldsHelper t (combineInlinefragmentObjectWithPresent rst h)--- with list of Field and one ScalarType, we want a union set of list and new ScalarType+compressSubFieldsHelper [] rst = rst+-- from list of Field and one ScalarType to a union set of list and new ScalarType combineScalarTypeWithPresent :: [Field] -> ScalarType -> [Field] combineScalarTypeWithPresent fld st = combineScalarTypeWithPresentHelper fld st [] combineScalarTypeWithPresentHelper :: [Field] -> ScalarType -> [Field] -> [Field]-combineScalarTypeWithPresentHelper [] st acc = acc++[Left st] combineScalarTypeWithPresentHelper ((Left h):t) st acc   | h==st = acc++((Left h):t) combineScalarTypeWithPresentHelper (h:t) st acc = combineScalarTypeWithPresentHelper t st $ acc++[h]--- with list of Field and one NestedObject, we want a union set of list and new NestedObject+combineScalarTypeWithPresentHelper [] st acc = acc++[Left st]+-- from list of Field and one NestedObject to a union set of list and new NestedObject combineNestedObjectWithPresent :: [Field] -> NestedObject -> [Field] combineNestedObjectWithPresent fld no = combineNestedObjectWithPresentHelper fld no [] combineNestedObjectWithPresentHelper :: [Field] -> NestedObject -> [Field] -> [Field]-combineNestedObjectWithPresentHelper [] no acc = acc++[Right $ Left no] 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   | 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] combineInlinefragmentObjectWithPresent :: [Field] -> InlinefragmentObject -> [Field]-combineInlinefragmentObjectWithPresent [] ifo = [Right $ Right ifo] combineInlinefragmentObjectWithPresent ((Right (Left h)):t) ifo = (Right $ Left h):combineInlinefragmentObjectWithPresent t ifo combineInlinefragmentObjectWithPresent ((Right (Right h)):t) ifo   | isSameIFObjectReference h ifo = (Right $ Right $ mergeIFObjects h ifo):t combineInlinefragmentObjectWithPresent (h:t) ifo = h:combineInlinefragmentObjectWithPresent t ifo--- we want 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.+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--- we want one InlinefragmentObject that is same ServerObject and is union set subfields with two InlinefragmentObjects that are same reference (ServerObject)+-- 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

@@ -43,12 +43,10 @@ -- 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 _ _ [] _ = [] replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs] -- TODO -- check parent object subselection -- finish no dups in parse schema--- change all left/right pattern match to also pattern match inside  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]@@ -58,28 +56,28 @@     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 sss ((pnt,_,[]):rst) = if pnt==obj then throw InvalidObjectException else getScalarTypeForVariableReplacement obj st sss rst-getScalarTypeForVariableReplacement obj st sss ((pnt,_,(fst:_)):rst) = if pnt==obj then getScalarTypeForVariableReplacement fst st sss [] else getScalarTypeForVariableReplacement obj st sss rst-getScalarTypeForVariableReplacement _ _ [] _ = throw InvalidObjectException-getScalarTypeForVariableReplacement obj st ((h,sts):rst) _+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 _ [] = throw InvalidScalarException 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 _ _ [] = throw InvalidScalarException 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

@@ -41,20 +41,19 @@ removeComments :: String -> String removeComments str = removeCommentsHelper str False removeCommentsHelper :: String -> Bool -> String-removeCommentsHelper [] _ = [] removeCommentsHelper ('#':t) _ = removeCommentsHelper t True -- removeCommentsHelper ('\r':t) _ = '\r':removeCommentsHelper t False removeCommentsHelper ('\n':t) _ = '\n':removeCommentsHelper t False-removeCommentsHelper (_:t) True = removeCommentsHelper t True-removeCommentsHelper (h:t) mde = h:removeCommentsHelper t mde+removeCommentsHelper (h:t) False = h:removeCommentsHelper t False+removeCommentsHelper (_:t) _ = removeCommentsHelper t True+removeCommentsHelper "" _ = "" -- NOTE: this is used with only the textarea field of forms since they are giving line breaks these combinations... removeLinebreaks :: String -> String-removeLinebreaks "" = "" removeLinebreaks ('\n':t) = ' ':removeLinebreaks t removeLinebreaks ('\r':t) = removeLinebreaks t removeLinebreaks ('\t':t) = ' ':removeLinebreaks t removeLinebreaks (h:t) = h:removeLinebreaks t-+removeLinebreaks "" = ""  {-----Step 2. VALIDATION-----} validateQuery :: String -> Bool@@ -64,21 +63,20 @@ validateBracketLocationQuery :: String -> Bool validateBracketLocationQuery str = validateBracketLocationQueryHelper str 0 0 validateBracketLocationQueryHelper :: String -> Int -> Int -> Bool-validateBracketLocationQueryHelper "" x y = (x==y) 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 = validateBracketLocationQueryHelper t o c+validateBracketLocationQueryHelper "" x y = (x==y) validateNoEmptyBrackets :: String -> Bool validateNoEmptyBrackets str = validateNoEmptyBracketsHelper str "" [] validateNoEmptyBracketsHelper :: String -> String -> [String] -> Bool-validateNoEmptyBracketsHelper "" acc nst = (length nst)<1+validateNoEmptyBracketsHelper (' ':b) acc [] = validateNoEmptyBracketsHelper b acc []+validateNoEmptyBracketsHelper (' ':b) acc (i:j) = validateNoEmptyBracketsHelper b acc (i:j) validateNoEmptyBracketsHelper ('{':b) acc [] = validateNoEmptyBracketsHelper b [] [acc] validateNoEmptyBracketsHelper ('}':b) acc [] = False-validateNoEmptyBracketsHelper (' ':b) acc [] = validateNoEmptyBracketsHelper b acc [] validateNoEmptyBracketsHelper (a:b) acc [] = validateNoEmptyBracketsHelper b (acc++[a]) []-validateNoEmptyBracketsHelper (' ':b) acc (i:j) = validateNoEmptyBracketsHelper b acc (i:j) validateNoEmptyBracketsHelper ('{':b) acc (i:j)  | (length acc)==0 = False  | otherwise = validateNoEmptyBracketsHelper b [] (acc:i:j)@@ -86,6 +84,7 @@  | (length acc)==0 = False  | otherwise = validateNoEmptyBracketsHelper b i j validateNoEmptyBracketsHelper (a:b) acc (i:j) = validateNoEmptyBracketsHelper b (acc++[a]) (i:j)+validateNoEmptyBracketsHelper "" acc nst = (length nst)<1   {-----Step 3. PARSING-----}@@ -100,20 +99,20 @@ getQueryAndFragments :: String -> (String, String) getQueryAndFragments str = getQueryAndFragmentsHelper str 0 False "" "" getQueryAndFragmentsHelper :: String -> Int -> Bool -> String -> String -> (String, String)-getQueryAndFragmentsHelper "" _ _ x y = (x, y) getQueryAndFragmentsHelper ('{':t) l False q f = getQueryAndFragmentsHelper t (l+1) False (q++"{") f getQueryAndFragmentsHelper ('}':t) 1 False q f = getQueryAndFragmentsHelper t 0 True (q++"}") f getQueryAndFragmentsHelper ('}':t) l False q f = getQueryAndFragmentsHelper t (l-1) False (q++"}") f getQueryAndFragmentsHelper (h:t) l False q f = getQueryAndFragmentsHelper t l False (q++[h]) f getQueryAndFragmentsHelper (h:t) l m q f = getQueryAndFragmentsHelper t l m q (f++[h])+getQueryAndFragmentsHelper "" _ _ x y = (x, y) parseFragments :: String -> [(String,[String])] -> [(String,[String],[String])] -> [Fragment] parseFragments str svrobjs soa = parseFragmentsHelper str "" 0 [] svrobjs soa parseFragmentsHelper :: String -> String -> Int -> [Fragment] -> [(String,[String])] -> [(String,[String],[String])] -> [Fragment]-parseFragmentsHelper "" _ _ rslt _ _ = rslt parseFragmentsHelper ('{':t) acc l rslt svrobjs soa = parseFragmentsHelper t (acc++"{") (l+1) rslt svrobjs soa parseFragmentsHelper ('}':t) acc 1 rslt svrobjs soa = parseFragmentsHelper t [] 0 ((createFragment acc svrobjs soa):rslt) svrobjs soa -- completed one fragment parseFragmentsHelper ('}':t) acc l rslt svrobjs soa = parseFragmentsHelper t (acc++"}") (l-1) rslt svrobjs soa  -- closed a nested object parseFragmentsHelper (h:t) acc l rslt svrobjs soa = parseFragmentsHelper t (acc++[h]) l rslt svrobjs soa+parseFragmentsHelper "" _ _ rslt _ _ = rslt -- with a fragment string that is without closing curly braces, we want a fragments createFragment :: String -> [(String,[String])] -> [(String,[String],[String])] -> Fragment createFragment str svrobjs soa = createFragmentHelper str 0 [] False False False False "" "" svrobjs soa@@ -124,7 +123,34 @@     o is for object -} createFragmentHelper :: String -> Int -> String -> Bool -> Bool -> Bool -> Bool -> String -> String -> [(String,[String])] -> [(String,[String],[String])] -> Fragment-createFragmentHelper "" l acc d n a o rst1 rst2 svrobjs soa = if (l==1&&d==True&&n==True&&a==True&&o==True) then Fragment { name=rst1,targetObject=(readServerObject rst2 svrobjs soa),replacement=acc } else throw ParseFragmentException+createFragmentHelper (' ':t) 0 acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t 0 "" True True True True rst1 rst2 svrobjs soa+createFragmentHelper ('{':t) 0 acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t 1 "" True True True True rst1 rst2 svrobjs soa+createFragmentHelper (_:_) 0 _ True True True True _ _ _ _ = throw ParseFragmentException+createFragmentHelper ('{':t) l acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) (acc++"{") True True True True rst1 rst2 svrobjs soa+createFragmentHelper ('}':t) l acc True True True True rst1 rst2 svrobjs soa = createFragmentHelper t (l-1) (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 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 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 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 (' ':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 (' ':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 ('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@@ -135,41 +161,15 @@ createFragmentHelper ('t':t) l "fragmen" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "fragment" False n a o rst1 rst2 svrobjs soa createFragmentHelper (' ':t) l "fragment" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True n a o rst1 rst2 svrobjs soa createFragmentHelper (' ':t) l "" False n a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" False n a o rst1 rst2 svrobjs soa-createFragmentHelper _ _ _ False _ _ _ _ _ _ _ = throw ParseFragmentException-createFragmentHelper (' ':t) l "" _ False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True False a o rst1 rst2 svrobjs soa-createFragmentHelper (' ':t) l acc _ False a o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True a o acc rst2 svrobjs soa-createFragmentHelper (h:t) l acc _ 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 (' ':t) l "" _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True False o rst1 rst2 svrobjs soa-createFragmentHelper (' ':t) l "on" _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True o rst1 rst2 svrobjs soa-createFragmentHelper (' ':_) _ _ _ _ False _ _ _ _ _ = throw ParseFragmentException-createFragmentHelper ('o':t) l acc _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"o") True True False o rst1 rst2 svrobjs soa-createFragmentHelper ('n':t) l acc _ _ False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"n") True True False o rst1 rst2 svrobjs soa-createFragmentHelper _ _ _ _ _ False _ _ _ _ _ = throw ParseFragmentException-createFragmentHelper (' ':t) l "" _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True False rst1 rst2 svrobjs soa-createFragmentHelper (h:t) l "" _ _ _ 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 (' ':t) l acc _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True True rst1 acc svrobjs soa-createFragmentHelper ('{':t) l acc _ _ _ False rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) "" True True True True rst1 acc svrobjs soa-createFragmentHelper (h:t) l acc _ _ _ False rst1 rst2 svrobjs soa- | isValidIdentifierChar h = createFragmentHelper t l (acc++[h]) True True True False rst1 rst2 svrobjs soa- | otherwise = throw ParseFragmentException-createFragmentHelper (' ':t) 0 acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t 0 "" True True True True rst1 rst2 svrobjs soa-createFragmentHelper ('{':t) 0 acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t 1 "" True True True True rst1 rst2 svrobjs soa-createFragmentHelper _ 0 _ _ _ _ _ _ _ _ _ = throw ParseFragmentException-createFragmentHelper ('{':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t (l+1) (acc++"{") True True True True rst1 rst2 svrobjs soa-createFragmentHelper ('}':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t (l-1) (acc++"}") True True True True rst1 rst2 svrobjs soa-createFragmentHelper (' ':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++" ") True True True True rst1 rst2 svrobjs soa-createFragmentHelper (')':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++")") True True True True rst1 rst2 svrobjs soa-createFragmentHelper ('(':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"(") True True True True rst1 rst2 svrobjs soa-createFragmentHelper (':':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++":") True True True True rst1 rst2 svrobjs soa-createFragmentHelper ('$':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"$") True True True True rst1 rst2 svrobjs soa-createFragmentHelper ('@':t) l acc _ _ _ _ rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"@") True True True True rst1 rst2 svrobjs soa-createFragmentHelper (h:t) l acc _ _ _ _ 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 (_:_) _ _ False _ _ _ _ _ _ _ = throw ParseFragmentException+createFragmentHelper (' ':t) l "" True True False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True False o rst1 rst2 svrobjs soa+createFragmentHelper (' ':t) l "on" True True False o rst1 rst2 svrobjs soa = createFragmentHelper t l "" True True True o rst1 rst2 svrobjs soa+createFragmentHelper (' ':_) _ _ True True False _ _ _ _ _ = throw ParseFragmentException+createFragmentHelper ('o':t) l acc True True False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"o") True True False o rst1 rst2 svrobjs soa+createFragmentHelper ('n':t) l acc True True False o rst1 rst2 svrobjs soa = createFragmentHelper t l (acc++"n") True True False o rst1 rst2 svrobjs soa+createFragmentHelper (_:_) _ _ True True False _ _ _ _ _ = throw ParseFragmentException+createFragmentHelper "" l acc d n a o rst1 rst2 svrobjs soa = if (l==1&&d==True&&n==True&&a==True&&o==True) then Fragment { name=rst1,targetObject=(readServerObject rst2 svrobjs soa),replacement=acc } else throw ParseFragmentException+ -- 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)@@ -179,12 +179,12 @@ -- call after infering types on nested objects -- get block in this scope splitSubject :: String -> String -> Int -> (String,String)-splitSubject "" acc _ = (acc,"") splitSubject (h:t) acc l  | l<0 = (acc,h:t) splitSubject ('{':t) acc l = splitSubject t (acc++"{") (l+1) 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 -- parse provided string to obtain query {-@@ -198,9 +198,9 @@ composeObjects "" _ _ _ _ _ = throw EmptyQueryException composeObjects str svrobjs sos soa vars fmts = composeObjectsHelper str 0 svrobjs sos soa vars fmts composeObjectsHelper :: String -> Int -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> RootObjects-composeObjectsHelper "" _ _ _ _ _ _ = throw EmptyQueryException composeObjectsHelper ('{':t) 0 svrobjs sos soa vars fmts = separateRootObjects (extractLevel t) svrobjs sos soa vars fmts -- find and separate every root object 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)@@ -217,22 +217,22 @@ 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 "" _ _ _ _ _ _ = [] 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 separateRootObjectsHelper (h:t) acc svrobjs sos soa vars fmts = separateRootObjectsHelper t (acc++[h]) svrobjs sos soa vars fmts+separateRootObjectsHelper "" _ _ _ _ _ _ = [] -- create root object from block -- EFFECTS: passing code block to parseSubFields where block is not including root object opening and closing curly brackets. createNestedObject :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> Maybe ServerObject -> NestedObject createNestedObject str svrobjs sos soa vars fmts sobj = createNestedObjectHelper str "" svrobjs sos soa vars fmts sobj createNestedObjectHelper :: String -> String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> Maybe ServerObject -> NestedObject-createNestedObjectHelper "" _ _ _ _ _ _ _ = throw InvalidObjectException  -- we should not encounter this since we already checked against empty brackets createNestedObjectHelper ('{':t) acc svrobjs sos soa vars fmts sobj = NestedObject (parseAlias acc) (parseName acc) serverObj (parseSubSelection acc) ((parseSubFields (extractLevel t) svrobjs sos soa vars fmts serverObj) :: SubFields) :: RootObject   where     serverObj = parseServerObject acc svrobjs sos soa sobj createNestedObjectHelper (h:t) acc svrobjs sos soa vars fmts sobj = createNestedObjectHelper t (acc++[h]) svrobjs sos soa vars fmts sobj+createNestedObjectHelper "" _ _ _ _ _ _ _ = throw InvalidObjectException  -- we should not encounter this since we already checked against empty brackets -- given object header without any braces, we want a name. parseServerObject :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> Maybe ServerObject -> ServerObject parseServerObject "" svrobjs sos soa Nothing = readServerObject "" svrobjs soa@@ -259,23 +259,26 @@  | (elem ':' str)==True = removeSpaces $ foldl' (\y x -> if x==':' then "" else (y++[x])) "" str  | otherwise = removeSpaces str parseSubSelection :: String -> SubSelection-parseSubSelection "" = Nothing :: SubSelection parseSubSelection ('(':t)  | (elem ':' t)==True&&(elem ')' t)==True = Just (ScalarType (Nothing :: Alias) ((removeSideSpaces (foldr (\x y -> if x==':' then "" else x:y) "" t)) :: Name) (Nothing :: Transformation) ((Just $ removeSideSpaces $ foldl' (\y x -> if x==':' then "" else (y++[x])) "" (foldr (\x y -> if x==')' then "" else x:y) "" t)) :: Argument)) :: SubSelection parseSubSelection (h:t) = parseSubSelection t+parseSubSelection "" = Nothing :: SubSelection -- REQUIRES: code block on nested object subfields where nested object opening and closing curly brackets are not included parseSubFields :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> ServerObject -> [Field] parseSubFields "" _ _ _ _ _ _ = [] 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 "" "" "" _ _ _ _ _ _ _ = []-parseSubFieldsHelper "" "" acc _ _ _ True _ _ _ = [(Left $ createScalarType acc) :: Field]-parseSubFieldsHelper "" "" acc _ _ _ False _ _ _ = []-parseSubFieldsHelper "" acc "" _ _ _ True _ _ _ = [(Left $ createScalarType acc) :: Field]-parseSubFieldsHelper "" acc "" _ _ _ False _ _ _ = []--- There is not a case where both acc1 and acc2 are not empty, but I'll catch anyway-parseSubFieldsHelper "" acc1 acc2 _ _ _ True _ _ _ = (Left $ createScalarType (acc2++acc1)):[]-parseSubFieldsHelper "" acc1 acc2 _ _ _ False _ _ _ = []+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    +  where+    (level,levelTail) = splitLevel t "" 0+parseSubFieldsHelper ('{':t) acc1 acc2 svrobjs sos soa _ vars fmts sobj+    | (length acc1)>0 = parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj    +    | (length acc2)>0 = parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj+  where+    (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@@ -292,16 +295,6 @@     | (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 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-    | (length acc1)>0 = parseSubFieldsHelper levelTail "" "" svrobjs sos soa True vars fmts sobj    -    | (length acc2)>0 = 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     | 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@@ -322,18 +315,24 @@     (isInlineFragment,inlinefragmentObj,inlinefragmentBody,inlinefragmentTail) = checkInlinefragment ('.':t)     (fragmentName,fragmentTail) = findFragment ('.':t)     fContents = expandFragment fragmentName sobj fmts-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 (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 "" "" "" _ _ _ _ _ _ _ = []+parseSubFieldsHelper "" "" acc _ _ _ True _ _ _ = [(Left $ createScalarType acc) :: Field]+parseSubFieldsHelper "" "" acc _ _ _ False _ _ _ = []+parseSubFieldsHelper "" acc "" _ _ _ True _ _ _ = [(Left $ createScalarType acc) :: Field]+parseSubFieldsHelper "" acc "" _ _ _ False _ _ _ = []+-- There is not a case where both acc1 and acc2 are not empty, but I'll catch anyway+parseSubFieldsHelper "" acc1 acc2 _ _ _ True _ _ _ = (Left $ createScalarType (acc2++acc1)):[]+parseSubFieldsHelper "" acc1 acc2 _ _ _ False _ _ _ = []+   checkInlinefragment :: String -> (Bool,String,String,String) checkInlinefragment str = checkInlinefragmentHelper str "" False "" checkInlinefragmentHelper :: String -> String -> Bool -> String -> (Bool,String,String,String)-checkInlinefragmentHelper "" _ _ _ = (False,"","","") checkInlinefragmentHelper ('.':t) "" sobj obj = checkInlinefragmentHelper t "." False "" checkInlinefragmentHelper _ "" _ _ = throw ParseFragmentException checkInlinefragmentHelper ('.':t) "." sobj obj = checkInlinefragmentHelper t ".." False ""@@ -359,7 +358,8 @@ checkInlinefragmentHelper (' ':t) acc _ obj = checkInlinefragmentHelper t acc True obj checkInlinefragmentHelper ('{':t) acc _ obj = (True,obj,contents,tail)   where-    (contents,tail) = splitSubject t "" 0 +    (contents,tail) = splitSubject t "" 0+checkInlinefragmentHelper "" _ _ _ = (False,"","","") checkInlinefragmentHelper _ _ _ _ = throw ParseFragmentException      createInlinefragmentObject :: String -> String -> [(String,String,String)] -> [Fragment] -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> InlinefragmentObject@@ -369,44 +369,40 @@ findFragment "" = throw ParseFragmentException findFragment str = findFragmentHelper str "" findFragmentHelper :: String -> String -> (String,String)-findFragmentHelper "" acc = (acc,"")+findFragmentHelper (h:t) ('.':'.':'.':acc)+ | isValidFragmentNameChar h = findFragmentHelper t (('.':'.':'.':acc)++[h]) findFragmentHelper ('.':t) "" = findFragmentHelper t "."-findFragmentHelper _ "" = throw ParseFragmentException+findFragmentHelper (_:_) "" = throw ParseFragmentException findFragmentHelper ('.':t) "." = findFragmentHelper t ".."-findFragmentHelper _ "." = throw ParseFragmentException+findFragmentHelper (_:_) "." = throw ParseFragmentException findFragmentHelper ('.':t) ".." = findFragmentHelper t "..."-findFragmentHelper _ ".." = throw ParseFragmentException-findFragmentHelper (h:t) "..."- | isValidFragmentNameChar h = findFragmentHelper t ("..."++[h])- | otherwise = throw ParseFragmentException+findFragmentHelper (_:_) ".." = throw ParseFragmentException findFragmentHelper (' ':t) acc = (acc,t)-findFragmentHelper (h:t) acc- | isValidFragmentNameChar h = findFragmentHelper t (acc++[h])+findFragmentHelper "" acc = (acc,"") findFragmentHelper _ _ = throw ParseFragmentException      expandFragment :: String -> ServerObject -> [Fragment] -> String-expandFragment _ _ [] = throw ParseFragmentException expandFragment fnm sobj (h:t) = if (targetObject h)==sobj&&fnm==("..."++(name h)) then replacement h else expandFragment fnm sobj t+expandFragment _ _ [] = throw ParseFragmentException  removeLeadingSpaces :: String -> String-removeLeadingSpaces "" = "" removeLeadingSpaces (' ':t) = removeLeadingSpaces t removeLeadingSpaces str = str -- EFFECTS: return subselection and String remainder getSubSelection :: String -> (String,String) getSubSelection str = getSubSelectionHelper str "" getSubSelectionHelper :: String -> String -> (String,String)-getSubSelectionHelper "" acc = ("","") getSubSelectionHelper (')':t) acc = (acc++")", t) getSubSelectionHelper (h:t) acc = getSubSelectionHelper t (acc++[h])+getSubSelectionHelper "" acc = ("","") -- split level at and without uneven brace. splitLevel :: String -> String -> Int -> (String,String)-splitLevel "" acc _ = (acc,[]) splitLevel (h:t) acc l  | l<0 = (acc,(h:t)) splitLevel ('{':t) acc l = splitLevel t (acc++"{") (l+1) splitLevel ('}':t) acc l = splitLevel t (acc++"}") (l-1) splitLevel (h:t) acc l = splitLevel t (acc++[h]) l+splitLevel "" acc _ = (acc,[]) -- determine if directive result is to include or exclude checkDirective :: String -> [(String,String,String)] -> (Bool, String) checkDirective qry vars = if (isDirective qry)==False then (True,qry) else checkDirectiveHelper (getDirective qry) vars@@ -421,9 +417,8 @@     directive = toLowercase dir     value = if h=='$' then toLowercase $ getVariableValue vars (h:t) else toLowercase (h:t) isDirective :: String -> Bool-isDirective "" = False-isDirective ('@':_) = True isDirective (' ':t) = isDirective t+isDirective ('@':_) = True isDirective _ = False getDirective :: String -> (String,String,String) getDirective (' ':t) = getDirective t@@ -433,30 +428,30 @@     val = removeSideSpaces $ foldl' (\y x -> if x==':' then "" else y++[x]) "" $ getPrefix t ')'     tail = getSuffix t ')' getPrefix :: String -> Char -> String-getPrefix "" _ = "" getPrefix (h:t) chr = if h==chr then "" else h:getPrefix t chr+getPrefix "" _ = "" getSuffix :: String -> Char -> String-getSuffix "" _ = "" getSuffix (h:t) chr = if h==chr then t else getSuffix t chr+getSuffix "" _ = "" toLowercase :: String -> String toLowercase str = [toLower c | c <- str] getVariableValue :: [(String,String,String)] -> String -> String-getVariableValue [] _ = throw InvalidVariableNameException getVariableValue ((name,"Bool",val):t) var  | (name==var) = val getVariableValue ((name,typ,val):t) var  | (name==var) = throw MismatchedVariableTypeException  | otherwise = getVariableValue t var+getVariableValue [] _ = throw InvalidVariableNameException -- pull level and leave out closing brace. extractLevel :: String -> String extractLevel "" = "" extractLevel str = extractLevelHelper str 0 extractLevelHelper :: String -> Int -> String-extractLevelHelper "" _ = "" extractLevelHelper ('{':t) l = '{':extractLevelHelper t (l+1) extractLevelHelper ('}':t) 0 = "" 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 [] = []

@@ -52,12 +52,12 @@     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 [] = soa parseParentsIterator soa (obj:t) = if foldr' (\(prev,_,_) acc->(prev==name)||acc) False soa then throw ImportSchemaDuplicateException 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@@ -88,19 +88,19 @@     name = getString (valFromObj "Name" h :: Result String) 1     options = getScalarArgumentOptions (getObjects (valFromObj "Options" h :: Result [JSObject JSValue])) getScalarArgumentOptions :: [JSObject JSValue] -> [(String,String,String,String)]-getScalarArgumentOptions [] = [] getScalarArgumentOptions (h:t) = (name,typ,prefix,suffix):getScalarArgumentOptions t   where     name = getString (valFromObj "Name" h :: Result String) 1     typ = getType (valFromObj "Type" h :: Result String)     prefix = getString (valFromObj "Prefix" h :: Result String) 1     suffix = getString (valFromObj "Suffix" h :: Result String) 1+getScalarArgumentOptions [] = [] getObjectFields :: [JSObject JSValue] -> [(String,[String])]-getObjectFields [] = [] getObjectFields (h:t) = (obj, names):getObjectFields t   where     obj = getString (valFromObj "ServerName" h :: Result String) 0     names = getStringList (valFromObj "Names" h :: Result [String]) 0+getObjectFields [] = [] getType :: Result String -> String getType (Ok "Text") = "Text" getType (Ok "ByteString") = "ByteString"@@ -125,40 +125,38 @@ 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) isNoDupsNames :: [String] -> Bool-isNoDupsNames [] = True 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 isNoDupsScalarNames :: [(String,String,[(String,[(String,String,String,String)])])] -> Bool-isNoDupsScalarNames [] = True isNoDupsScalarNames ((name,_,args):rst) = (foldr' (\(x,_,_) y->name/=x&&y) True rst)&&(isNoDupsScalarArguments args)&&isNoDupsScalarNames rst+isNoDupsScalarNames [] = True isNoDupsScalarArguments :: [(String,[(String,String,String,String)])] -> Bool-isNoDupsScalarArguments [] = True isNoDupsScalarArguments ((name,opts):rst) = (foldr' (\(n,o) y->name/=n&&y&&isNoDupsArgumentOptions o) True rst)&&isNoDupsScalarArguments rst+isNoDupsScalarArguments [] = True isNoDupsArgumentOptions :: [(String,String,String,String)] -> Bool-isNoDupsArgumentOptions [] = True isNoDupsArgumentOptions ((name,_,_,_):rst) = (foldr' (\(n,_,_,_) y->name/=n&&y) True rst)&&isNoDupsArgumentOptions rst+isNoDupsArgumentOptions [] = True isNoDupsNestedObjects :: [(String,[(String,[String])])] -> Bool-isNoDupsNestedObjects [] = True 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     noDupNms = isNoDupsNames nms+isNoDupsNestedObjects [] = True isNoDupsRelationships :: [(String,String,[String])] -> Bool-isNoDupsRelationships [] = True isNoDupsRelationships ((from,to,_):rst) = (foldr' (\(a,b,_) y->(from/=a||to/=b)&&y) True rst)&&isNoDupsRelationships rst+isNoDupsRelationships [] = True -- shared scalars are same type isValidParentScalars :: [(String,[String],[String])] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool-isValidParentScalars [] _ = True isValidParentScalars ((_,_,[]):t) 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 [] _ = True getPrimitiveScalars :: String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,String)]-getPrimitiveScalars _ [] = throw ImportSchemaChildrenException getPrimitiveScalars name ((nm,st):t) = if name==nm then foldr' (\(n,tp,_) y->(n,tp):y) [] st else getPrimitiveScalars name t+getPrimitiveScalars _ [] = throw ImportSchemaChildrenException isValidScalarsType :: [(String,String)] -> [String] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> Bool-isValidScalarsType _ [] _ = True-isValidScalarsType [] _ _ = True 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 [] _ _ = True

@@ -14,23 +14,23 @@     )  --- with a variables string and query string, we want the query variables, the type, and the value+-- from a variables string and query string to the query variables, the type, and the value parseVariables :: String -> String -> [(String,String,String)] parseVariables var qry = filterToDesired (parseVariableValuePairs var) (getVariableTypePairs qry)--- with variable-values and variable-types, we want query variable-type-values+-- from variable-values and variable-types to query variable-type-values 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] findVariableValue :: (String,String,Maybe String) -> [(String,String)] -> (String,String,String)-findVariableValue (vname,vtype,Nothing) [] =  throw MissingVariableValueException-findVariableValue (vname,vtype,Just vval) [] = (vname,vtype,vval :: 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 getDefaultValues :: [(String,String,Maybe String)] -> [(String,String,String)] getDefaultValues vars = [(nam,typ,val) | (nam,typ,Just val)<-vars]--- from given variables argument, we want variable-values+-- from given variables argument to variable-values parseVariableValuePairs :: String -> [(String,String)] parseVariableValuePairs [] = [] parseVariableValuePairs vars = castValues $ fromJSObject $ checkVariables (decode vars :: Result (JSObject JSValue))@@ -52,8 +52,8 @@   where     epilogue = getQueryEpilogue qry getQueryEpilogue :: String -> String-getQueryEpilogue [] = throw EmptyQueryException getQueryEpilogue (h:t) = if h=='{' then [] else h:(getQueryEpilogue t)+getQueryEpilogue [] = throw EmptyQueryException removeLeadingSpaces :: String -> String removeLeadingSpaces (h:t) = if h==' ' then removeLeadingSpaces t else (h:t) separateVariables :: Bool -> String -> Bool -> String -> String -> String -> [(String,String,Maybe String)]

@@ -35,44 +35,68 @@   )  -makeSqlQueries :: [RootObject] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> ([[[String]]],[[String]])-makeSqlQueries [] _ _ _ _ = ([],[])-makeSqlQueries rojs sss sodn sor soa = unzip [unzip y | y<-[makeSqlQuerySet sss sodn sor soa x | x<-rojs]]-makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> [([String],String)]-makeSqlQuerySet sss sodn sor soa obj = if (length dbNames)==1 then 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 (firstTable:[]) else (foldr (\x y -> x++y) [] [(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 (x:[])) | (xIds,x)<-dbNames, let xName=x++(show 1)])+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)])                            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 [] [] [] [] -- 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   where-    numStr = show number    -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])] -> [String] -> [([String],String)]-addSqlQueryFields [] counts select from order [] [] _ _ _ _ tbls = [(tbls,(removeLastChar select)++from++order++";")]-addSqlQueryFields [] _ _ _ _ [] _ _ _ _ _ _ = throw CreatingSqlQueryObjectFieldsException-addSqlQueryFields [] counts select from order _ [] _ _ _ _ tbls = [(tbls,(removeLastChar select)++from++order++";")]-addSqlQueryFields [] counts select from order (_:b) (h:t) sss sodn sor soa tbls = addSqlQueryFields h counts select from order b t sss sodn sor soa tbls-addSqlQueryFields (_:t) _ _ _ _ [] _ _ _ _ _ _ = throw CreatingSqlQueryObjectsException  -- fields without objects-addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls = addSqlQueryFields t counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls-addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls = addSqlQueryFields t counts (select++ltable++(show ltableNo)++"."++name++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls-addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls = addSqlQueryFields t counts (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls+    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   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 select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls-    | (length tables)>1 = foldl' (\y x-> x++y) [] [addSqlQueryFields (getSubFields h) newCounts (select++(makeTableIdentifier xName xIds "")++",") (from++(makeTransitions newCounts (getDBObjectRelationships ltable x sor) h)) (order++","++(makeTableIdentifier xName xIds " asc")) ((x,xNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa (x:tbls) | (xIds,x)<-tables, let newCounts=calcNewCounts ltable x counts sor, let xNum=(!) newCounts x, let xName=x++(show xNum)]-    | (length tables)>0 = addSqlQueryFields (getSubFields h) firstTableNewCounts (select++(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 (firstTable:tbls)+-- 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   where     tables = translateServerObjectToDBName (getServerObject h) sodn soa+    tablesLen = length tables     (firstTableIds, firstTable) = head tables     firstTableNewCounts = calcNewCounts ltable firstTable counts sor     firstTableNum = (!) firstTableNewCounts firstTable     firstTableName = firstTable++(show firstTableNum)-addSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls-    | isServerObjectTable ltable ifo sodn soa = addSqlQueryFields (sfs++t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls-addSqlQueryFields (h:t) counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls = addSqlQueryFields t counts select from order ((ltable,ltableNo):names) fields sss sodn sor soa tbls+    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)])+  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+  where+    (nlvl,nfst,_) = last li+    (nids,sel,frm,ord) = last lqs+    nrqs = (ids,select,from,order):rqs+    nli = init li+    nri = (lvl,True,ltbl):ri+addSqlQueryFields _ _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ lvl False li ri _ rqs = ([li++((lvl,False,ltable):ri)],[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 removeLastChar :: String -> String@@ -82,11 +106,11 @@ getNewTables :: [String] -> [String] getNewTables lnk = getNewTablesHelper (tail $ tail lnk) 0 getNewTablesHelper :: [String] -> Int -> [String]-getNewTablesHelper [] _ = [] 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 [] _ = [] 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@@ -96,12 +120,12 @@     table3NumStr = show $ (!) counts h3 makeTransitions _ _ _ = throw RelationshipConfigurationException completeTransition :: Map String Int -> [String] -> NestedObject -> String-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)-  where-    table1NumStr = show $ (!) counts h1 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)   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)+  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@@ -119,32 +143,31 @@ getFirstColumn :: String -> (String,String) getFirstColumn str = getFirstColumnHelper "" str getFirstColumnHelper :: String -> String -> (String,String)-getFirstColumnHelper _ "" = ("","") getFirstColumnHelper acc (' ':t) = (acc,t) getFirstColumnHelper acc (h:t) = getFirstColumnHelper (acc++[h]) t+getFirstColumnHelper _ "" = ("","")  getPrimitiveScalarTypeArgumentOptions :: ServerObject -> String -> String -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> (String,String)-getPrimitiveScalarTypeArgumentOptions _ _ _ _ [] = throw InvalidObjectException 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 getScalarTypeArgumentsOptions :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> (String,String)-getScalarTypeArgumentsOptions _ _ _ [] = throw InvalidScalarException getScalarTypeArgumentsOptions st trans arg ((name,_,args):t)  | st==name = getArgumentOptions trans arg args  | otherwise = getScalarTypeArgumentsOptions st trans arg t+getScalarTypeArgumentsOptions _ _ _ [] = throw InvalidScalarException getArgumentOptions :: String -> Argument -> [(String,[(String,String,String,String)])] -> (String,String)-getArgumentOptions _ _ [] = throw InvalidArgumentException getArgumentOptions trans arg ((aname,opts):rst)  | trans==aname = getArgumentOption arg opts  | otherwise = getArgumentOptions trans arg rst+getArgumentOptions _ _ [] = throw InvalidArgumentException getArgumentOption :: Argument -> [(String,String,String,String)] -> (String,String)-getArgumentOption _ [] = throw InvalidArgumentException 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 makeTableIdentifier :: String -> [String] -> String -> String+makeTableIdentifier tbl (fid:ids) ins = foldl' (\y x->y++tbl++"."++x++ins++",") [] (fid:ids) makeTableIdentifier _ [] _ = []-makeTableIdentifier tbl (h:[]) ins = tbl++"."++h++ins-makeTableIdentifier tbl (h:t) ins = tbl++"."++h++ins++","++(makeTableIdentifier tbl t ins)

@@ -571,7 +571,7 @@ 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.+                   -> (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@@ -603,7 +603,7 @@ -} processQueryData :: 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.+                 -> [[[[[Text]]]]]  -- ^ 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

@@ -41,4 +41,4 @@  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,[[String]])]+type QueryData = [(RootObject,[[(Int,Bool,String)]])]