diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for graphql-w-persistent +## 0.9.1.0 -- 2020-09-17 + +* Fixed bug in getting all data from aggregate queries, now merging nested objects + ## 0.9.0.0 -- 2020-06-01 * Null values are now supported; table are now supported to appear more than once in joins; data types are simplified for .json file support; alternative json aggregate SQL query functions are now supported for faster queries; error is fixed from version 0.8.0.0 for more than two nested objects; inline fragments were not working in version 0.8.0.0, but it is now working; and removed a requirement for "Unexpected nulls" for null values which is making easy compliance with other databases packages and types. diff --git a/graphql-w-persistent.cabal b/graphql-w-persistent.cabal --- a/graphql-w-persistent.cabal +++ b/graphql-w-persistent.cabal @@ -10,10 +10,10 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.9.0.0 +version: 0.9.1.0 -- A short (one-line) description of the package. -synopsis: GraphQL interface middleware for (SQL) databases. +synopsis: GraphQL interface middleware for SQL databases. -- A longer description of the package. description: This is an application of GraphQL to querying SQL databases. The package functions are to interpret GraphQL string queries, to make SQL queries, and to process list-style database-returned values into a GraphQL string output (which you may use with another program). The data processing functions are designed for the Persistent library return values, but any (Eq a) => [[a]] returned type is valid input to this library if translations (and a check for null value) are provided for data types (Text, Int64, Double, and Boolean). Prospect packages are the odbc package (with the query function) and HDBC package (with the quickQuery function). You may find another to suit your stack. Examples and applications are available at the homepage (GitHub). I would like a star while you are there. @@ -48,7 +48,7 @@ -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 -tested-with: GHC >=8.2.2 && <=8.8.3 +tested-with: GHC >=8.2.2 && <=8.8.4 stability: provisional bug-reports: https://github.com/jasonsychau/graphql-w-persistent/issues diff --git a/src/Components/DataProcessors/ListDataProcessor.hs b/src/Components/DataProcessors/ListDataProcessor.hs --- a/src/Components/DataProcessors/ListDataProcessor.hs +++ b/src/Components/DataProcessors/ListDataProcessor.hs @@ -145,10 +145,14 @@ getGqlRow _ _ [] tblsRows tblsRem = (tblsRows,tblsRem) getGqlRow idCnt fstIds (tbl:dat) tblsRows tblsRem = getGqlRow idCnt fstIds dat (tblsRows++[nxtRow]) (tblsRem++[nxtRem]) where - (nxtRow,nxtRem) = foldl' (\(rowRlt,remRlt) row -> if (==) fstIds $ take idCnt row then - (rowRlt++[drop idCnt row],remRlt) - else - (rowRlt,remRlt++[row])) ([],[]) tbl + (nxtRow,nxtRem) = takeInstanceRow idCnt fstIds tbl [] +takeInstanceRow :: (Eq a) => Int -> [a] -> [[a]] -> [[a]] -> ([[a]],[[a]]) +takeInstanceRow idCnt fstIds (row:rem) rlt = + if (==) fstIds $ take idCnt row then + takeInstanceRow idCnt fstIds rem (rlt++[drop idCnt row]) + else + (rlt,(row:rem)) +takeInstanceRow _ _ _ rlt = (rlt,[]) castJSType :: ((a -> Text),(a -> Double),(a -> Int64),(a -> Bool),(a -> Bool)) -> String -> a -> JSValue castJSType (toText,_,_,_,_) "Text" val = showJSON $ toText val @@ -168,7 +172,8 @@ packageAggSubFields transFx sss sodn soa sobj tbls sfs rlts = packageAggSubFieldsForEveryRow transFx sss sodn soa sobj sfs grpdInstcByObjInst where dtaByInstCbntn = zip tbls rlts - grpdInstcByObjInst = foldl' (\rlt (nInst,nDta)->if (thd4 $ head nInst)==False then + grpdInstcByObjInst = + foldl' (\rlt (nInst,nDta)->if (thd4 $ head nInst)==False then ((init rlt)++[(last rlt)++[(nInst,(nDta,snd $ snd $ head $ last rlt))]]) else rlt++[[(nInst,(nDta,countTableIds (fth4 $ head nInst) sodn))]]) [[(fst $ head dtaByInstCbntn,(snd $ head dtaByInstCbntn,countTableIds (fth4 $ head $ fst $ head dtaByInstCbntn) sodn))]] $ tail dtaByInstCbntn @@ -178,6 +183,7 @@ (_,_,_,_,isNull) = transFx objInstWRw = map (filter (not . null . head . fst . snd)) dt objWInst = filter (\nObj->(null nObj)==False) objInstWRw + (nxtObjsRw,remIs) = foldl' (\(objRows,remRows) nObj-> let (nObjRow,nObjRem) = foldl' (\(nInstRow,nInstRem) (tbls,(dSet,idC))->let (rowData,remData) = separateGqlRow isNull idC dSet in (nInstRow++[(tbls,rowData)],nInstRem++[(tbls,(remData,idC))])) ([],[]) nObj in (objRows++[unzip nObjRow],remRows++[nObjRem])) ([],[]) objWInst @@ -198,6 +204,7 @@ makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) dat = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (fth4 $ head $ head tbls) sodn):(makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls b dat) makeOneGQLObjFrmAgg (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) ((((i:j):k):l):m) = (getScalarFieldLabel $ ScalarType alias name trans arg, if isNull i then JSNull else castJSType (fx1,fx2,fx3,fx4,isNull) (findPrimitiveScalarTypeType (translateTableToObject (fth4 $ head $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObjFrmAgg (fx1,fx2,fx3,fx4,isNull) sss sodn soa sobj tbls b (((j:k):l):m)) + makeOneGQLObjFrmAgg transFx sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) ((j:k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs $ packageAggSubFields transFx sss sodn soa nso objTbls sfs objData):(makeOneGQLObjFrmAgg transFx sss sodn soa sobj remTbls b remData) where (objTbls,objData,remTbls,remData) = sepAggDataFrNstdObj tbls ((j:k):l) @@ -217,6 +224,7 @@ let nxtTblsInfo = tail instMt tNxtTblsInfo = tail nxtTblsInfo + (_,objLvl,_,_) = head nxtTblsInfo nestedObjCount = foldr' (\(_,nlvl,_,_) rlt->if nlvl<=objLvl then 0 else rlt+1) 0 tNxtTblsInfo fQrydPos = foldr' (\(idx,(_,_,fst,_)) rlt->if fst then idx else rlt) ((length nxtTblsInfo)-1) $ zip [0..] nxtTblsInfo @@ -225,7 +233,8 @@ if hasQrd then ([tail instMt],[instDt],[],[]) else - ([],[],[(head instMt):(drop (nestedObjCount+1) $ tail instMt)],[instDt])) $ tail $ zip info dat + ([],[],[(head instMt):(drop (nestedObjCount+1) $ tail instMt)],[instDt]) + ) $ tail $ zip info dat fstInstInfo = head info fstInstDat = head dat (fstC,fstL,fstF,fstT) = head fstInstInfo diff --git a/src/Components/ObjectHandlers/ServerObjectInspector.hs b/src/Components/ObjectHandlers/ServerObjectInspector.hs --- a/src/Components/ObjectHandlers/ServerObjectInspector.hs +++ b/src/Components/ObjectHandlers/ServerObjectInspector.hs @@ -44,10 +44,8 @@ isValidSubField obj (Right (Left (NestedObject alias name sobject ss sfs))) sss soa = hasValidAttributes (NestedObject alias name sobject ss sfs) sss soa isValidSubField obj (Right (Right (InlinefragmentObject ifo sfs))) sss soa = (isValidServerObjectChild obj ifo soa)&&isValidSubFields ifo sfs sss soa -- replace variables with values and do type checking --- ASSUME: variables are prefixed with $ replaceObjectsVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> [(String,String,String)] -> [RootObject] replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs] --- finish no dups in parse schema replaceObjectVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> RootObject -> [(String,String,String)] -> RootObject replaceObjectVariables sss soa (NestedObject alias name sobject Nothing sfs) vars = NestedObject alias name sobject Nothing [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs] replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans Nothing)) sfs) vars = NestedObject alias name sobject (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs] diff --git a/src/Components/ObjectHandlers/ServerObjectTrimmer.hs b/src/Components/ObjectHandlers/ServerObjectTrimmer.hs --- a/src/Components/ObjectHandlers/ServerObjectTrimmer.hs +++ b/src/Components/ObjectHandlers/ServerObjectTrimmer.hs @@ -20,9 +20,9 @@ mergeDuplicatedRootObjects :: [RootObject] -> [RootObject] mergeDuplicatedRootObjects [] = [] -mergeDuplicatedRootObjects robjs = mergeDuplicatedRootObjectsHelper robjs [] +mergeDuplicatedRootObjects robjs = compressROsSubFields $ mergeDuplicatedRootObjectsHelper robjs [] mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject] -mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences (rst++[mergeDuplicates h duplicates]) +mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences ((mergeDuplicates h duplicates):rst) where (duplicates, differences) = separateDuplicatesAndDifferences h t mergeDuplicatedRootObjectsHelper [] rst = rst -- two lists of duplicates and differences @@ -36,10 +36,13 @@ | 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 (NestedObject alias name sobj ss sf1) ((NestedObject _ _ _ _ sf2):t) = mergeDuplicates (NestedObject alias name sobj ss (compressSubFields (sf1++sf2))) t +mergeDuplicates (NestedObject alias name sobj ss sf1) ((NestedObject _ _ _ _ sf2):t) = mergeDuplicates (NestedObject alias name sobj ss (sf1++sf2)) t mergeDuplicates robj [] = robj + +compressROsSubFields :: [RootObject] -> [RootObject] +compressROsSubFields ((NestedObject alias name sobj ss sfs):t) = (NestedObject alias name sobj ss $ compressNextDepth $ compressSubFields sfs):(compressROsSubFields t) +compressROsSubFields [] = [] -- from list of Fields to merged duplicate Fields compressSubFields :: [Field] -> [Field] compressSubFields [] = [] @@ -56,8 +59,8 @@ combineScalarTypeWithPresentHelper :: [Field] -> ScalarType -> [Field] -> [Field] combineScalarTypeWithPresentHelper ((Left h):t) st acc | h==st = acc++((Left h):t) -combineScalarTypeWithPresentHelper (h:t) st acc = combineScalarTypeWithPresentHelper t st $ acc++[h] -combineScalarTypeWithPresentHelper [] st acc = acc++[Left st] +combineScalarTypeWithPresentHelper (h:t) st acc = combineScalarTypeWithPresentHelper t st $ h:acc +combineScalarTypeWithPresentHelper [] st acc = (Left st):acc -- 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 [] @@ -67,7 +70,7 @@ | isSameNObjectReference h no = throw DuplicateObjectsException | otherwise = combineNestedObjectWithPresentHelper t no ((Right $ Left h):acc) combineNestedObjectWithPresentHelper (h:t) no acc = combineNestedObjectWithPresentHelper t no (h:acc) -combineNestedObjectWithPresentHelper [] no acc = acc++[Right $ Left no] +combineNestedObjectWithPresentHelper [] no acc = (Right $ Left no):acc combineInlinefragmentObjectWithPresent :: [Field] -> InlinefragmentObject -> [Field] combineInlinefragmentObjectWithPresent ((Right (Left h)):t) ifo = (Right $ Left h):combineInlinefragmentObjectWithPresent t ifo combineInlinefragmentObjectWithPresent ((Right (Right h)):t) ifo @@ -76,7 +79,12 @@ 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 error "Requested object merge is for different things (source error)." +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 (sfs1++sfs2) else error "Requested object merge is for different things (source error)." -- one InlinefragmentObject that is same ServerObject and is union set subfields with two InlinefragmentObjects that are same reference (ServerObject) mergeIFObjects :: InlinefragmentObject -> InlinefragmentObject -> InlinefragmentObject -mergeIFObjects (InlinefragmentObject sobj1 sfs1) (InlinefragmentObject sobj2 sfs2) = if sobj1==sobj2 then InlinefragmentObject sobj1 (compressSubFields (sfs1++sfs2)) else error "Requested object merge is for different things (source error)." +mergeIFObjects (InlinefragmentObject sobj1 sfs1) (InlinefragmentObject sobj2 sfs2) = if sobj1==sobj2 then InlinefragmentObject sobj1 (sfs1++sfs2) else error "Requested object merge is for different things (source error)." +compressNextDepth :: [Field] -> [Field] +compressNextDepth ((Left h):t) = (Left h):(compressNextDepth t) +compressNextDepth ((Right (Left (NestedObject alias name sobj ss sfs))):t) = (Right (Left (NestedObject alias name sobj ss $ compressNextDepth $ compressSubFields sfs))):(compressNextDepth t) +compressNextDepth ((Right (Right (InlinefragmentObject sobj sfs))):t) = (Right (Right (InlinefragmentObject sobj $ compressNextDepth $ compressSubFields sfs))):(compressNextDepth t) +compressNextDepth [] = [] diff --git a/src/Components/Parsers/QueryParser.hs b/src/Components/Parsers/QueryParser.hs --- a/src/Components/Parsers/QueryParser.hs +++ b/src/Components/Parsers/QueryParser.hs @@ -44,7 +44,6 @@ removeComments str = removeCommentsHelper str False removeCommentsHelper :: String -> Bool -> String removeCommentsHelper ('#':t) _ = removeCommentsHelper t True --- removeCommentsHelper ('\r':t) _ = '\r':removeCommentsHelper t False removeCommentsHelper ('\n':t) _ = '\n':removeCommentsHelper t False removeCommentsHelper (h:t) False = h:removeCommentsHelper t False removeCommentsHelper (_:t) _ = removeCommentsHelper t True @@ -111,12 +110,6 @@ -- 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 -{- - d is for declaration - n is for name - a is for arrangement - o is for object --} createFragmentHelper :: String -> Int -> String -> Bool -> Bool -> Bool -> Bool -> String -> String -> [(String,[String])] -> [(String,[String],[String])] -> Fragment 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 @@ -172,14 +165,13 @@ splitSubject ('}':t) acc l = splitSubject t (acc++"}") (l-1) splitSubject (h:t) acc l = splitSubject t (acc++[h]) l splitSubject "" acc _ = (acc,"") --- substitute target string with replacement string within subject string...return result +-- -- substitute target string with replacement string within subject string...return result -- parse provided string to obtain query {- REQUIRES: Query is balanced and ordered brackets. input is whole query string with opening and closing brackets EFFECTS: Return value is list of desired objects with specifications passing code block to separateRootObjects() where code block is not including query opening and closing brackets -TODO: change Bool to Either with exceptions -} composeObjects :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> RootObjects composeObjects "" _ _ _ _ _ = throw EmptyQueryException @@ -189,6 +181,9 @@ composeObjectsHelper (_:t) l svrobjs sos soa vars fmts = composeObjectsHelper t l svrobjs sos soa vars fmts composeObjectsHelper "" _ _ _ _ _ _ = throw EmptyQueryException -- ...separate and determine operation +-- REQUIRES: brackets are balanced and ordered +-- NOTE: only querying is first supported; mutations are later +-- EFFECTS: passing block to createNestedObject where block is including opening and closing curly brackets separateRootObjects :: String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> [RootObject] separateRootObjects str svrobjs sos soa vars fmts = separateRootObjectsHelper str "" svrobjs sos soa vars fmts separateRootObjectsHelper :: String -> String -> [(String,[String])] -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> [(String,String,String)] -> [Fragment] -> [RootObject] @@ -421,7 +416,6 @@ extractLevelHelper ('}':t) l = '}':extractLevelHelper t (l-1) extractLevelHelper (h:t) l = h:extractLevelHelper t l extractLevelHelper "" _ = "" --- remove level and leave out closing brace removeSpaces :: String -> String removeSpaces str = [x | x <- str, x/=' '] createScalarType :: String -> ScalarType @@ -441,9 +435,6 @@ | otherwise = Nothing :: Argument removeSideSpaces :: String -> String removeSideSpaces str = foldl' (\y x -> if x==' '&&(length y)==0 then "" else y++[x]) "" $ foldr (\x y -> if x==' '&&(length y)==0 then "" else x:y) "" str --- parseOperation :: String -> Operation --- TODO: support mutations - {-----Step 4. CROSS-CHECKING-----} -- done by ServerObjectValidator.hs diff --git a/src/Components/QueryComposers/SQLQueryComposer.hs b/src/Components/QueryComposers/SQLQueryComposer.hs --- a/src/Components/QueryComposers/SQLQueryComposer.hs +++ b/src/Components/QueryComposers/SQLQueryComposer.hs @@ -1,4 +1,4 @@ -module Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries) where +module Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries) where -- ,makeSQLiteQueries import Data.Map.Strict (fromList,Map,(!),insertWith) import Control.Exception (throw) @@ -43,28 +43,28 @@ makeSqlQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [RootObject] -> ([[[(Int,Bool,String)]]],[[[String]]]) makeSqlQueries sss sodn sor soa rojs = unzip [makeSqlQuerySet sss sodn sor soa robj | robj<-rojs] -makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> ([[(Int,Bool,String)]],[[String]]) +makeSqlQuerySet :: [(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 = (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) where dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa (firstIds,firstTable) = head dbNames firstTableName = firstTable++(show 1) - (fstTbls,fstQrys) = addSqlQueryFields (getSubFields obj) (fromList [(firstTable,1)]) ("SELECT "++(makeTableIdentifier firstTableName firstIds "")) "" (" FROM"++(makeSqlTablePhrase obj firstTable 1)) (((firstTable,1):[])) [] sss sodn sor soa 0 True [] [] [] [] - (nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let xName=x++(show 1) in addSqlQueryFields (getSubFields obj) (fromList [(x,1)]) ("SELECT "++(makeTableIdentifier xName xIds "")) "" (" FROM"++(makeSqlTablePhrase obj x 1)) ((x,1):[]) [] sss sodn sor soa 0 True [] [] [] []) $ tail dbNames + (fstTbls,fstQrys) = 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 [] [] [] [] + (nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let xName=x++(show 1) in addSqlQueryFields (getSubFields obj) (fromList [(x,1)]) ("SELECT "++(makeTableIdentifier xName xIds "")) "" (" FROM"++(makeSqlTablePhrase obj x 1)) (" ORDER BY "++(makeTableIdentifier xName xIds " ASC")) ((x,1):[]) [] sss sodn sor soa 0 True [] [] [] []) $ tail dbNames -- making table phrase when there is only one sql table makeSqlTablePhrase :: NestedObject -> String -> Int -> String makeSqlTablePhrase obj name number = if (withSubSelection obj)==True then " (SELECT * FROM "++name++" WHERE "++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj)++") AS "++name++numStr else " "++name++" AS "++name++numStr where numStr = show number -- make queries for object of one table (most common is first - PCA example) -addSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Int -> Bool -> [(Int,Bool,String)] -> [(Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Bool,String)]],[[String]]) -addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs -addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs -addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs +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 ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ((newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs) +addSqlQueryFields ((Right (Left h)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ((newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0",""):rqs) where tables = translateServerObjectToDBName (getServerObject h) sodn soa tablesLen = length tables @@ -74,7 +74,7 @@ firstTableName = firstTable++(show firstTableNum) newLvl = lvl+1 objSfs = getSubFields h - (fstTbls,fstQrys) = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa newLvl True (li++[(lvl,True,ltable)]) ri (lqs++[(ids,select,from)]) rqs + (fstTbls,fstQrys) = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) (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 (nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let (newCounts,transition)=makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable x sor) h xNum=(!) newCounts x @@ -83,27 +83,27 @@ flsLRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) li)++[(lvl,False,ltable)] flsRRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) ri) in - addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa newLvl True flsLRcds flsRRcds [("","","") | _<-flsLRcds] [("","","") | _<-flsRRcds]) $ tail tables -addSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs]) + addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) (order++(makeTableIdentifier xName xIds " ASC")) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa newLvl True flsLRcds flsRRcds [("","","","") | _<-flsLRcds] [("","","","") | _<-flsRRcds]) $ tail tables +addSqlQueryFields [] _ ids select from order ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs]) where - (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,True,ltbl):ri)) ((ids,select,from):rqs) - lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs] - rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs] -addSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields h counts nids sel frm b t sss sodn sor soa nlvl nfst nli nri (init lqs) nrqs + (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,True,ltbl):ri)) ((ids,select,from,order):rqs) + lQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-lqs] + rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-filter ((/=) ("","","","")) nrqs] +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) = last lqs - nrqs = (ids,select,from):rqs + (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++(map snd nri)],[rQrs]) +addSqlQueryFields _ _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs]) where - (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,False,ltable):ri)) (("","",""):rqs) - rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs] -addSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs - | isServerObjectTable ltable ifo sodn soa = addSqlQueryFields (sfs++t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs -addSqlQueryFields (_:t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs = addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs -addSqlQueryFields _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ = error "No objects are here for remaining fields (EOF source error)." + (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,False,ltable):ri)) (("","","",""):rqs) + rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-filter ((/=) ("","","","")) nrqs] +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 _ _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ = error "No objects are here for remaining fields (EOF source error)." -- fields without objects removeLastChar :: String -> String removeLastChar "" = "" removeLastChar str = init str @@ -160,14 +160,14 @@ makeTableIdentifier tbl (fid:ids) ins = concat $ map (\x->tbl++"."++x++ins++",") (fid:ids) makeTableIdentifier _ [] _ = [] -reverseNeighbourQueries :: [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))] +reverseNeighbourQueries :: [((Int,a),(String,String,String,String))] -> [((Int,a),(String,String,String,String))] reverseNeighbourQueries qrys = let maxLvl = findMaxLevel qrys in rearrangeQueriesAtLevel maxLvl [] qrys -findMaxLevel :: [((Int,a),(String,String,String))] -> Int +findMaxLevel :: [((Int,a),(String,String,String,String))] -> Int findMaxLevel qrys = recordMaxLevel 0 qrys -recordMaxLevel :: Int -> [((Int,a),(String,String,String))] -> Int +recordMaxLevel :: Int -> [((Int,a),(String,String,String,String))] -> Int recordMaxLevel rlt (((nxt,_),_):t) = recordMaxLevel (max rlt nxt) t recordMaxLevel rlt _ = rlt -rearrangeQueriesAtLevel :: Int -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))] +rearrangeQueriesAtLevel :: Int -> [((Int,a),(String,String,String,String))] -> [((Int,a),(String,String,String,String))] -> [((Int,a),(String,String,String,String))] rearrangeQueriesAtLevel 0 clc [] = clc rearrangeQueriesAtLevel lvl clc (((nLvl,dat),qry):t) = if nLvl==lvl then rearrangeQueriesAtLevel lvl (clc++nOrd) rem @@ -176,7 +176,7 @@ where (nOrd,rem) = collectQueriesAndRearrange lvl [] (((nLvl,dat),qry):t) rearrangeQueriesAtLevel lvl clc [] = rearrangeQueriesAtLevel (lvl-1) [] clc -collectQueriesAndRearrange :: Int -> [[((Int,a),(String,String,String))]] -> [((Int,a),(String,String,String))] -> ([((Int,a),(String,String,String))],[((Int,a),(String,String,String))]) +collectQueriesAndRearrange :: Int -> [[((Int,a),(String,String,String,String))]] -> [((Int,a),(String,String,String,String))] -> ([((Int,a),(String,String,String,String))],[((Int,a),(String,String,String,String))]) collectQueriesAndRearrange lvl grps (((nLvl,dat),qry):t) | nLvl==lvl = collectQueriesAndRearrange lvl (grps++[[((nLvl,dat),qry)]]) t | nLvl>lvl = collectQueriesAndRearrange lvl ((init grps)++[(last grps)++[((nLvl,dat),qry)]]) t @@ -186,12 +186,12 @@ -- AGG QUERIES makeSqlAggQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [[FlagNode]] -> [RootObject] -> ([[[(Int,Int,Bool,String)]]],[[[String]]]) makeSqlAggQueries sss sodn sor soa flgs rojs = unzip [makeSqlAggRootObjectQuerySet sss sodn sor soa oflgs robj | (oflgs,robj)<-zip flgs rojs] -makeSqlAggRootObjectQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [FlagNode] -> RootObject -> ([[(Int,Int,Bool,String)]],[[String]]) +makeSqlAggRootObjectQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [FlagNode] -> RootObject -> ([[(Int,Int,Bool,String)]],[[String]]) -- [([(Int,String)],[String])] ([[(Int,String)]],[[String]]) makeSqlAggRootObjectQuerySet sss sodn sor soa flgs obj = (concat tbls,concat qrys) where (tbls,qrys) = unzip $ map (\(FlagNode val nds,(tblIds,tbl))->let tblName=(++) tbl $ show 1 - sfs = getSubFields obj in if val<2 then ([[(val,0,True,tbl)]],[[makeSqlAggQuery sss sodn sor soa (fromList []) [(tbl,0)] "result0 AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(" (")) FROM "++tbl++" AS "++tbl++(show 0)) sfs [] ((if withSubSelection obj then " WHERE "++tbl++(show 0)++"."++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj) else "")++") SELECT "++(foldl' (++) "" ["0," | _<-tblIds])++"* FROM result0;")]]) else addAggSqlQueryFields sfs (fromList [(tbl,1)]) ("SELECT "++(makeTableIdentifier tblName tblIds "")) "" (" FROM"++(makeSqlTablePhrase obj tbl 1)) ((tbl,1):[]) [] sss sodn sor soa (FlagNode val nds) [] 0 True [] [] [] []) $ zip flgs dbNames + sfs = getSubFields obj in if val<2 then ([[(val,0,True,tbl)]],[[makeSqlAggQuery sss sodn sor soa (fromList []) [(tbl,0)] "result0 AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(" (")) FROM "++tbl++" AS "++tbl++(show 0)) sfs [] ((if withSubSelection obj then " WHERE "++tbl++(show 0)++"."++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj) else "")++") SELECT "++(foldl' (++) "" ["0," | _<-tblIds])++"* FROM result0;")]]) else addAggSqlQueryFields sfs (fromList [(tbl,1)]) ("SELECT "++(makeTableIdentifier tblName tblIds "")) "" (" FROM"++(makeSqlTablePhrase obj tbl 1)) (" ORDER BY "++(makeTableIdentifier tblName tblIds " ASC")) ((tbl,1):[]) [] sss sodn sor soa (FlagNode val nds) [] 0 True [] [] [] []) $ zip flgs dbNames dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa makeSqlAggQuery :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Map String Int -> [(String,Int)] -> String -> String -> [Field] -> [(String,String,[Field])] -> String -> String makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end [] [] filterGroupSelect = "WITH "++(init def)++end++filterGroupSelect @@ -227,7 +227,6 @@ makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end (nsfs++sfs) rem filterGroupSelect else makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end sfs rem filterGroupSelect - makeAggLinks :: [(String,[String],String)] -> String -> String -> String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String,String,String) makeAggLinks sodn frmName toName aggName cnts (h1:h2:h3:h4:h5:h6:h7:t) nobj = completeAggLinks sodn (" FROM "++(if withSubSelection nobj then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++") AS "++frmName else h1++" AS "++frmName)++" INNER JOIN "++h5++" AS "++nxtTbl++" ON "++(makeEqColumns frmName (sepColString h2) nxtTbl (sepColString h6))) nxtTbl aggName toName frmName nxtCnt (h3:h4:h5:h6:h7:t) where @@ -257,28 +256,31 @@ sepColString :: String -> [String] sepColString str = if elem ' ' str then foldl' (\(h:t) nChar->if nChar==' ' then ("":h:t) else ((h++[nChar]):t)) [""] str else [str] -addAggSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> FlagNode -> [FlagNode] -> Int -> Bool -> [(Int,Int,Bool,String)] -> [(Int,Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Int,Bool,String)]],[[String]]) -addAggSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs -addAggSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs -addAggSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs + +addAggSqlQueryFields :: 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])] -> FlagNode -> [FlagNode] -> Int -> Bool -> [(Int,Int,Bool,String)] -> [(Int,Int,Bool,String)] -> [(String,String,String,String)] -> [(String,String,String,String)] -> ([[(Int,Int,Bool,String)]],[[String]]) -- [[((Int,String),String)]] +addAggSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs +addAggSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs +addAggSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs where (prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss -addAggSqlQueryFields ((Right (Left h)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val nds) retFlgs lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val (tail nds)) retFlgs lvl True li ((2,newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs) + + +addAggSqlQueryFields ((Right (Left h)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val nds) retFlgs lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addAggSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val (tail nds)) retFlgs lvl True li ((2,newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0",""):rqs) where tables = translateServerObjectToDBName (getServerObject h) sodn soa tablesLen = length tables (firstTableIds, firstTable) = head tables (firstTableNewCounts,transition) = makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable firstTable sor) h firstTableNum = (!) firstTableNewCounts firstTable - firstTableName = (++) firstTable $ show firstTableNum + firstTableName = (++) firstTable $ show firstTableNum newLvl = lvl+1 objSfs = getSubFields h (fstTbls,fstQrys) = if firstNodeFlg<2 then - addAggSqlQueryFields t firstTableNewCounts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa retNode retFlgs lvl True li ((firstNodeFlg,lvl+1,True,firstTable):ri) lqs (("","",aggQry):rqs) + addAggSqlQueryFields t firstTableNewCounts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa retNode retFlgs lvl True li ((firstNodeFlg,lvl+1,True,firstTable):ri) lqs (("","",aggQry,""):rqs) else - addAggSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa (head nds) (retNode:retFlgs) newLvl True (li++[(val,lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from)]++rqs) [] + addAggSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) (order++(makeTableIdentifier firstTableName firstTableIds " ASC")) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa (head nds) (retNode:retFlgs) newLvl True (li++[(val,lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from,order)]++rqs) [] where - aggQry = makeSqlAggQuery sss sodn sor soa firstTableNewCounts [(firstTable,firstTableNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids firstTableIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(drop 7 ids)++(listIdFields firstTableName (fetchTableIds firstTable sodn))++") SELECT * FROM result0") + aggQry = makeSqlAggQuery sss sodn sor soa firstTableNewCounts [(firstTable,firstTableNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids firstTableIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(init $ drop 7 ids)++(removeLastChar order)++") SELECT * FROM result0") firstNodeFlg = (\(FlagNode val _)->val) (head nds) retNode = FlagNode val $ drop tablesLen nds (nxtTbls,nxtQrys) = unzip $ map (\((FlagNode nVal nNds),(xIds,x))->let @@ -286,36 +288,36 @@ xNum=(!) newCounts x xName=x++(show xNum) (nInfo,nQrs) = if nVal<2 then - addAggSqlQueryFields [] counts ids select from ((ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode val []) emptyFlgs lvl False flsLRcds ((nVal,newLvl,True,x):flsRRcds) lStubQrys (("","",aggQry):rStubQrys) + addAggSqlQueryFields [] counts ids select from order ((ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode val []) emptyFlgs lvl False flsLRcds ((nVal,newLvl,True,x):flsRRcds) lStubQrys (("","",aggQry,""):rStubQrys) else - addAggSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode nVal nNds) ((FlagNode val []):emptyFlgs) newLvl True (flsLRcds++[(val,lvl,False,ltable)]) flsRRcds lStubQrys rStubQrys + addAggSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) (order++(makeTableIdentifier xName xIds " ASC")) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode nVal nNds) ((FlagNode val []):emptyFlgs) newLvl True (flsLRcds++[(val,lvl,False,ltable)]) flsRRcds lStubQrys rStubQrys where - aggQry = makeSqlAggQuery sss sodn sor soa newCounts [(x,xNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids xIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(init $ drop 7 ids)++") SELECT * FROM result0") + aggQry = makeSqlAggQuery sss sodn sor soa newCounts [(x,xNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids xIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(init $ drop 7 ids)++(removeLastChar order)++") SELECT * FROM result0") emptyFlds = ([]:[[] | _<-fields]) emptyFlgs = [FlagNode sVal [] | (FlagNode sVal _)<-retFlgs] flsLRcds = (map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) li) flsRRcds = map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) ri - lStubQrys = [("","","") | _<-flsLRcds] - rStubQrys = [("","","") | _<-flsRRcds] + lStubQrys = [("","","","") | _<-flsLRcds] + rStubQrys = [("","","","") | _<-flsRRcds] in (nInfo,nQrs)) $ tail $ zip nds tables -addAggSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ (FlagNode val _) retFlgs lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs]) +addAggSqlQueryFields [] _ ids select from order ((ltbl,_):_) [] _ _ _ _ (FlagNode val _) retFlgs lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs]) where - (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,True,ltbl):ri)) ((ids,select,from):rqs) - lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs] - rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs] -addAggSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa (FlagNode val _) retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields h counts nids sel frm b t sss sodn sor soa (head retFlgs) (tail retFlgs) nlvl nfst nli nri (init lqs) nrqs + (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,True,ltbl):ri)) ((ids,select,from,order):rqs) + lQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-lqs] + rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-filter ((/=) ("","","","")) nrqs] +addAggSqlQueryFields [] counts ids select from order ((ltbl,_):b) (h:t) sss sodn sor soa (FlagNode val _) retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields h counts nids sel frm ord b t sss sodn sor soa (head retFlgs) (tail retFlgs) nlvl nfst nli nri (init lqs) nrqs where (_,nlvl,nfst,_) = last li - (nids,sel,frm) = last lqs - nrqs = (ids,select,from):rqs + (nids,sel,frm,ord) = last lqs + nrqs = (ids,select,from,order):rqs nli = init li nri = (val,lvl,True,ltbl):ri -addAggSqlQueryFields _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ (FlagNode val _) _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs]) +addAggSqlQueryFields _ _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ (FlagNode val _) _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs]) where - (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,False,ltable):ri)) (("","",""):rqs) - rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs] -addAggSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs - | isServerObjectTable ltable ifo sodn soa = addAggSqlQueryFields (sfs++t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs -addAggSqlQueryFields (_:t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs -addAggSqlQueryFields _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ _ _ = error "Cannot find object for fields (source error)." + (nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,False,ltable):ri)) (("","","",""):rqs) + rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-filter ((/=) ("","","","")) nrqs] +addAggSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs + | isServerObjectTable ltable ifo sodn soa = addAggSqlQueryFields (sfs++t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs +addAggSqlQueryFields (_:t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs = addAggSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs +addAggSqlQueryFields _ _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ _ _ = error "Cannot find object for fields (source error)." -- fields without objects diff --git a/src/GraphQLdbi.hs b/src/GraphQLdbi.hs --- a/src/GraphQLdbi.hs +++ b/src/GraphQLdbi.hs @@ -7,11 +7,11 @@ is a link to the official documents. You can learn and get a feel of how can you implement this package which is a GraphQL-to-SQL translator with Persistent package style return-value processing to make a GraphQL format return object string. -This module is made to enable interpreting your GraphQL queries. The expected query type is a single string to comprise all your GraphQL queries and fragments, and the expected variable type is a single string to your variable-to-value definitions. +This module is made to enable interpreting your GraphQL queries. The expected query type is a single string to comprise all your GraphQL queries and fragments, and the expected variable type is a single string to variable-to-value definitions. -When errors are encountered, this module is simply going to throw an uncaught Exception. The Exception name is some hint to the cause to the error. More information is provided in the below function descriptions. +When errors are encountered, module is going to throw an uncaught Exception. The Exception name is a hint to the cause to the error. More information is provided in the below function descriptions. -Not all GraphQL features are currently supported. For a list to updates and current state, you should check the GitHub updates and example . Since this package is a middleware for your database and your client, you may make an external solution for the other GraphQL features. You may find an example in the mentioned repo. +Not all GraphQL features are currently supported. For a list to updates and current state, you should check the GitHub updates and example . Since this package is a middleware for your database and your client, you may make an external solution for the other GraphQL features. You may find an example in the before mentioned repo. -} module GraphQLdbi ( @@ -38,7 +38,7 @@ {- | - This function is to parse your schema. The return value is passed to the other two functions to interpret your schema. You can declare and define your schema with tuples and lists without reading a json file as defined in below function, but you will not receive type and duplicate checking from this function. You also may run this function once and declare the returned values before all the other function calls. + This function is to parse your schema. The return value is passed to the other two functions to interpret your schema. You can declare and define your schema with tuples and lists without reading a json file as defined in below function, but you will not receive type and duplicate checking from this function. You also may run this function once and declare the returned values in code. __Schema:__ @@ -88,45 +88,45 @@ @ { - "Interfaces":[ + \"Interfaces\":[ ({ - "ServerName":SERVEROBJECTNAME, - "Pseudonyms":[(String)+], - "ServerChildren":[(SERVEROBJECTNAME)+] + \"ServerName\":SERVEROBJECTNAME, + \"Pseudonyms\":[(String)+], + \"ServerChildren\":[(SERVEROBJECTNAME)+] })* ], - "PrimitiveObjects":[ + \"PrimitiveObjects\":[ ({ - "ServerName": SERVEROBJECTNAME, - "Pseudonyms": [(String)+], - "ScalarFields": [ + \"ServerName\": SERVEROBJECTNAME, + \"Pseudonyms\": [(String)+], + \"ScalarFields\": [ ({ - "Name": String, - "Type": DATATYPE, - "Arguments": [ + \"Name\": String, + \"Type\": DATATYPE, + \"Arguments\": [ ({ - "Name": String, - "Options": [ + \"Name\": String, + \"Options\": [ ({ - "Name": String, - "Type": TYPE, - "Prefix": String, - "Suffix": String + \"Name\": String, + \"Type\": TYPE, + \"Prefix\": String, + \"Suffix\": String })+ ] })* ] })* ], - "ObjectFields": [ + \"ObjectFields\": [ ({ - "Names": [String], - "ServerName": SERVEROBJECTNAME + \"Names\": [String], + \"ServerName\": SERVEROBJECTNAME })* ], - "DatabaseTable": String, - "UniqueIds": [String], - "DatabaseRelationships": [ + \"DatabaseTable\": String, + \"UniqueIds\": [String], + \"DatabaseRelationships\": [ ([FROMTABLE,FROMJOINIDS,TOTABLE,TOJOINIDS(,NEXTTABLEBYFROMTABLE,NEXTABLEENTRYIDS,NEXTTABLEEXITIDS)*])* ] })+ @@ -134,7 +134,7 @@ } SERVEROBJECTNAME = String - TYPE = "Text" | "Int64" | "Double" | "Boolean" + TYPE = \"Text\" | \"Int64\" | \"Double\" | \"Boolean\" FROMTABLE = String FROMJOINIDS = String TOTABLE = String @@ -164,7 +164,7 @@ {- | These two functions are to parse, validate, and interpret your GraphQL query with variables. If you don't have variables, you may pass an empty string. The function is expecting your schema as SchemaSpec type from the above function. You can alternatively define you schema with lists and tuples by calling the above function once and declaring the output as the SchemaSpec argument for this function, so you do not repeatedly parse the json schema file. - _Function return value:__ + __Function return value:__ The returned values are one tuple to contain query information to later pass to the data processing function. The tuple is (QueryData,SQLQueries). The second tuple member is a collection of queries to iterate and give to your database. @@ -242,7 +242,7 @@ * InvalidVariableTypeException (Variable type is not Text, Int64, Double, nor Boolean.) * ReadJsonException (Could not read json from database) -} -processQueryData :: (Eq a) +processQueryData :: (Eq a) -- ^ The database type is expected as instance from Eq class. => (a -> Text) -- ^ This is a function to transform database type to string -> (a -> Double) -- ^ This is a function to transform database type to Double -> (a -> Int64) -- ^ This is a function to transform database type to Int64 @@ -250,7 +250,7 @@ -> (a -> Bool) -- ^ This is a function to check for NULL data -> SchemaSpecs -- ^ This is the schema data from the first method -> QueryData -- ^ This is the package objects that is from processQueryString function. - -> [[[[[a]]]]] -- ^ This is the database query results value in the same order and after casting to Text values. + -> [[[[[a]]]]] -- ^ This is the database query results value in the same order. -> String -- ^ The return value is a string type to describe the GraphQL-organized return values. processQueryData toTxt toDbl toInt toBool isNull (_,sss,_,sodn,_,soa) qd dt = let (ro,tb) = unzip qd @@ -258,7 +258,7 @@ {- | This function is for processAggQueryString correspondence. -} -processAggQueryData :: (Eq a) +processAggQueryData :: (Eq a) -- ^ The database type is expected as instance from Eq class. => (a -> Text) -- ^ This is a function to transform database type to string -> (a -> Double) -- ^ This is a function to transform database type to Double -> (a -> Int64) -- ^ This is a function to transform database type to Int64 @@ -266,7 +266,7 @@ -> (a -> Bool) -- ^ This is a function to check for NULL data -> SchemaSpecs -- ^ This is the schema data from the first method -> AggQueryData -- ^ This is the package objects that is from processQueryString function. - -> [[[[[a]]]]] -- ^ This is the database query results value in the same order and after casting to Text values. + -> [[[[[a]]]]] -- ^ This is the database query results value in the same order. -> String -- ^ The return value is a string type to describe the GraphQL-organized return values. processAggQueryData toTxt toDbl toInt toBool isNull (_,sss,_,sodn,_,soa) qd dt = let (ro,tb) = unzip qd