module Components.QueryComposers.SQLQueryComposer (makeSqlQueries,makeSqlAggQueries) where
import Data.Map.Strict (fromList,Map,(!),insertWith)
import Control.Exception (throw)
import Data.List (foldl')
import Model.ServerObjectTypes (
RootObject,
NestedObject,
SubFields,
Argument,
ServerObject,
ScalarType(..),
InlinefragmentObject(..),
NestedObject(..),
Field,
FlagNode(..)
)
import Model.ServerExceptions (
ReferenceException(
RelationshipCardinalityException,
RelationshipLinkageIdException,
UnrecognisedObjectException,
UnrecognisedArgumentException,
UnrecognisedOptionException,
UnrecognisedScalarException
)
)
import Components.ObjectHandlers.ObjectsHandler (
translateServerObjectToDBName,
getSubSelectionArgument,
getSubSelectionField,
withSubSelection,
getDBObjectRelationships,
getServerObject,
isServerObjectTable,
getSubFields,
translateTableToObject,
getNestedObjectFieldLabel,
getScalarFieldLabel,
fetchTableIds
)
makeSqlQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [RootObject] -> ([[[(Int,Bool,String)]]],[[[String]]])
makeSqlQueries sss sodn sor soa rojs = unzip [makeSqlQuerySet sss sodn sor soa robj | robj<-rojs]
makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> ([[(Int,Bool,String)]],[[String]])
makeSqlQuerySet sss sodn sor soa obj = (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys))
where
dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa
(firstIds,firstTable) = head dbNames
firstTableName = firstTable++(show 1)
(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
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])] -> Int -> Bool -> [(Int,Bool,String)] -> [(Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Bool,String)]],[[String]])
addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
where
(prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss
addSqlQueryFields ((Right (Left h)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ((newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs)
where
tables = translateServerObjectToDBName (getServerObject h) sodn soa
tablesLen = length tables
(firstTableIds, firstTable) = head tables
(firstTableNewCounts,transition) = makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable firstTable sor) h
firstTableNum = (!) firstTableNewCounts firstTable
firstTableName = firstTable++(show firstTableNum)
newLvl = lvl+1
objSfs = getSubFields h
(fstTbls,fstQrys) = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa newLvl True (li++[(lvl,True,ltable)]) ri (lqs++[(ids,select,from)]) rqs
(nxtTbls,nxtQrys) = unzip $ map (\(xIds,x)->let
(newCounts,transition)=makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable x sor) h
xNum=(!) newCounts x
xName=x++(show xNum)
emptyFlds = ([]:[[] | _<-fields])
flsLRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) li)++[(lvl,False,ltable)]
flsRRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) ri)
in
addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa newLvl True flsLRcds flsRRcds [("","","") | _<-flsLRcds] [("","","") | _<-flsRRcds]) $ tail tables
addSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs])
where
(nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nl,nb,nt)->(nl,(nl,nb,nt))) ((lvl,True,ltbl):ri)) ((ids,select,from):rqs)
lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs]
rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]
addSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields h counts nids sel frm b t sss sodn sor soa nlvl nfst nli nri (init lqs) nrqs
where
(nlvl,nfst,_) = last li
(nids,sel,frm) = last lqs
nrqs = (ids,select,from):rqs
nli = init li
nri = (lvl,True,ltbl):ri
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)."
removeLastChar :: String -> String
removeLastChar "" = ""
removeLastChar str = init str
getNewTables :: [String] -> [String]
getNewTables lnk = getNewTablesHelper (tail $ tail lnk) 0
getNewTablesHelper :: [String] -> Int -> [String]
getNewTablesHelper (h:t) 0 = h:getNewTablesHelper (tail t) 3
getNewTablesHelper (h:t) idx = if (==) 0 $ mod idx 3 then h:getNewTablesHelper t (idx+1) else getNewTablesHelper t (idx+1)
getNewTablesHelper [] _ = []
makeTransitions :: String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String)
makeTransitions frm counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = completeTransition (" INNER JOIN "++h5++" AS "++nxtTbl++" ON "++(makeEqColumns frm (sepColString h2) nxtTbl (sepColString h6))) nxtTbl nxtCnt (h3:h4:h5:h6:h7:t) nobj
where
nxtCnt = insertWith (+) h5 1 counts
nxtTbl = (++) h5 $ show $ (!) nxtCnt h5
makeTransitions frm counts (h1:h2:h3:h4:_) nobj = (nxtCnt," INNER JOIN "++(if (withSubSelection nobj)==True then "(SELECT * FROM "++h3++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h3)++" AS "++nxtTbl++" ON "++(makeEqColumns frm (sepColString h2) nxtTbl (sepColString h4)))
where
nxtCnt = insertWith (+) h3 1 counts
nxtTbl = (++) h3 $ show $ (!) nxtCnt h3
makeTransitions _ _ _ _ = throw RelationshipCardinalityException
completeTransition :: String -> String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String)
completeTransition rlt prevTbl counts (h1:h2:h3:h4:h5:h6:h7:h8:t) nobj = completeTransition (rlt++" INNER JOIN "++h6++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h7))) nxtTbl nxtCnt (h1:h2:h6:h7:h8:t) nobj
where
nxtCnt = insertWith (+) h6 1 counts
nxtTbl = (++) h6 $ show $ (!) nxtCnt h6
completeTransition rlt prevTbl counts (h1:h2:h3:h4:h5:[]) nobj = (nxtCnt, rlt++" INNER JOIN "++(if (withSubSelection nobj)==True then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h1)++" AS "++h1++table1NumStr++" ON "++(makeEqColumns prevTbl (sepColString h5) (h1++table1NumStr) (sepColString h2)))
where
nxtCnt = insertWith (+) h1 1 counts
table1NumStr = show $ (!) nxtCnt h1
completeTransition _ _ _ _ _ = throw RelationshipCardinalityException
makeEqColumns :: String -> [String] -> String -> [String] -> String
makeEqColumns tb1 col1 tb2 col2 = if length col1 /= length col2 then throw RelationshipLinkageIdException else init $ concat $ map (\(nxt1,nxt2)->tb1++"."++nxt1++"="++tb2++"."++nxt2++",") $ zip col1 col2
getFirstColumn :: String -> (String,String)
getFirstColumn str = getFirstColumnHelper "" str
getFirstColumnHelper :: String -> String -> (String,String)
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 obj st trans arg ((h,sts):rst) = if h==obj then getScalarTypeArgumentsOptions st trans arg sts else getPrimitiveScalarTypeArgumentOptions obj st trans arg rst
getPrimitiveScalarTypeArgumentOptions _ _ _ _ [] = throw UnrecognisedObjectException
getScalarTypeArgumentsOptions :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> (String,String)
getScalarTypeArgumentsOptions st trans arg ((name,_,args):t) = if st==name then getArgumentOptions trans arg args else getScalarTypeArgumentsOptions st trans arg t
getScalarTypeArgumentsOptions _ _ _ [] = throw UnrecognisedScalarException
getArgumentOptions :: String -> Argument -> [(String,[(String,String,String,String)])] -> (String,String)
getArgumentOptions trans arg ((aname,opts):rst) = if trans==aname then getArgumentOption arg opts else getArgumentOptions trans arg rst
getArgumentOptions _ _ [] = throw UnrecognisedArgumentException
getArgumentOption :: Argument -> [(String,String,String,String)] -> (String,String)
getArgumentOption Nothing ((_,_,prefix,suffix):_) = (prefix,suffix)
getArgumentOption (Just opt) ((name,_,prefix,suffix):rst) = if opt==name then (prefix,suffix) else getArgumentOption (Just opt) rst
getArgumentOption _ [] = throw UnrecognisedOptionException
makeTableIdentifier :: String -> [String] -> String -> String
makeTableIdentifier tbl (fid:ids) ins = concat $ map (\x->tbl++"."++x++ins++",") (fid:ids)
makeTableIdentifier _ [] _ = []
reverseNeighbourQueries :: [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))]
reverseNeighbourQueries qrys = let maxLvl = findMaxLevel qrys in rearrangeQueriesAtLevel maxLvl [] qrys
findMaxLevel :: [((Int,a),(String,String,String))] -> Int
findMaxLevel qrys = recordMaxLevel 0 qrys
recordMaxLevel :: Int -> [((Int,a),(String,String,String))] -> Int
recordMaxLevel rlt (((nxt,_),_):t) = recordMaxLevel (max rlt nxt) t
recordMaxLevel rlt _ = rlt
rearrangeQueriesAtLevel :: Int -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))] -> [((Int,a),(String,String,String))]
rearrangeQueriesAtLevel 0 clc [] = clc
rearrangeQueriesAtLevel lvl clc (((nLvl,dat),qry):t) = if nLvl==lvl then
rearrangeQueriesAtLevel lvl (clc++nOrd) rem
else
rearrangeQueriesAtLevel lvl (clc++[((nLvl,dat),qry)]) t
where
(nOrd,rem) = collectQueriesAndRearrange lvl [] (((nLvl,dat),qry):t)
rearrangeQueriesAtLevel lvl clc [] = rearrangeQueriesAtLevel (lvl-1) [] clc
collectQueriesAndRearrange :: Int -> [[((Int,a),(String,String,String))]] -> [((Int,a),(String,String,String))] -> ([((Int,a),(String,String,String))],[((Int,a),(String,String,String))])
collectQueriesAndRearrange lvl grps (((nLvl,dat),qry):t)
| nLvl==lvl = collectQueriesAndRearrange lvl (grps++[[((nLvl,dat),qry)]]) t
| nLvl>lvl = collectQueriesAndRearrange lvl ((init grps)++[(last grps)++[((nLvl,dat),qry)]]) t
| otherwise = (concat $ reverse grps,((nLvl,dat),qry):t)
collectQueriesAndRearrange lvl grps [] = (concat $ reverse grps,[])
makeSqlAggQueries :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [[FlagNode]] -> [RootObject] -> ([[[(Int,Int,Bool,String)]]],[[[String]]])
makeSqlAggQueries sss sodn sor soa flgs rojs = unzip [makeSqlAggRootObjectQuerySet sss sodn sor soa oflgs robj | (oflgs,robj)<-zip flgs rojs]
makeSqlAggRootObjectQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> [FlagNode] -> RootObject -> ([[(Int,Int,Bool,String)]],[[String]])
makeSqlAggRootObjectQuerySet sss sodn sor soa flgs obj = (concat tbls,concat qrys)
where
(tbls,qrys) = unzip $ map (\(FlagNode val nds,(tblIds,tbl))->let
tblName=(++) tbl $ show 1
sfs = getSubFields obj in if val<2 then ([[(val,0,True,tbl)]],[[makeSqlAggQuery sss sodn sor soa (fromList []) [(tbl,0)] "result0 AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(" (")) FROM "++tbl++" AS "++tbl++(show 0)) sfs [] ((if withSubSelection obj then " WHERE "++tbl++(show 0)++"."++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj) else "")++") SELECT "++(foldl' (++) "" ["0," | _<-tblIds])++"* FROM result0;")]]) else addAggSqlQueryFields sfs (fromList [(tbl,1)]) ("SELECT "++(makeTableIdentifier tblName tblIds "")) "" (" FROM"++(makeSqlTablePhrase obj tbl 1)) ((tbl,1):[]) [] sss sodn sor soa (FlagNode val nds) [] 0 True [] [] [] []) $ zip flgs dbNames
dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa
makeSqlAggQuery :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Map String Int -> [(String,Int)] -> String -> String -> [Field] -> [(String,String,[Field])] -> String -> String
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end [] [] filterGroupSelect = "WITH "++(init def)++end++filterGroupSelect
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end [] ((ndef,nend,nsfs):rem) filterGroupSelect = makeSqlAggQuery sss sodn sor soa cnts lTbls ((init def)++end++ndef) nend nsfs rem filterGroupSelect
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType Nothing n Nothing _)):sfs) rem filterGroupSelect =
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++n++"',"++ltb++(show ltbNo)++"."++n++",") end sfs rem filterGroupSelect
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType (Just a) n Nothing _)):sfs) rem filterGroupSelect =
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++a++"',"++ltb++(show ltbNo)++"."++n++",") end sfs rem filterGroupSelect
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Left (ScalarType a n (Just trans) arg)):sfs) rem filterGroupSelect =
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) (def++"'"++(getScalarFieldLabel (ScalarType a n (Just trans) arg))++"',"++prefix++ltb++(show ltbNo)++"."++n++suffix++",") end sfs rem filterGroupSelect
where
(prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltb sodn) n trans arg sss
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Right (Left (NestedObject a n so ss nsfs))):sfs) rem filterGroupSelect =
if length dbNames == 0 then
makeSqlAggQuery sss sodn sor soa nCnts4 ((ltb,ltbNo):lTbls) (def++"'"++(getNestedObjectFieldLabel (NestedObject a n so ss nsfs))++"',JSON_ARRAY(),") end sfs rem filterGroupSelect
else
makeSqlAggQuery sss sodn sor soa nCnts4 ((tbl,tblNum):(ltb,ltbNo):lTbls) (nxtNOName++" AS (SELECT JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++" AS "++rltName++","++idAndJoins) nsfs ((groupBy++"),"++def++"'"++(getNestedObjectFieldLabel (NestedObject a n so ss nsfs))++"',IFNULL(JSON("++nxtNOName++"."++rltName++"),JSON_ARRAY()),",end++" LEFT OUTER JOIN "++nxtNOName++" ON "++cnct,sfs):rem) filterGroupSelect
where
dbNames = translateServerObjectToDBName so sodn soa
(ids,tbl) = head dbNames
nxtNO = ltb++tbl
nCnts = insertWith (+) nxtNO 1 cnts
nxtNONum = (!) nCnts nxtNO
nxtNOName = (++) nxtNO $ show nxtNONum
nCnts2 = insertWith (+) "result" 1 nCnts
rltNum = (!) nCnts2 "result"
rltName = (++) "result" $ show rltNum
nCnts3 = insertWith (+) tbl 1 (nCnts2)
tblNum = (!) nCnts3 tbl
(nCnts4,idAndJoins,groupBy,cnct) = makeAggLinks sodn ((++) tbl $ show tblNum) ((++) ltb $ show ltbNo) nxtNOName nCnts3 (getDBObjectRelationships tbl ltb sor) (NestedObject a n so ss nsfs)
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end ((Right (Right (InlinefragmentObject so nsfs))):sfs) rem filterGroupSelect =
if translateTableToObject ltb sodn == so then
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end (nsfs++sfs) rem filterGroupSelect
else
makeSqlAggQuery sss sodn sor soa cnts ((ltb,ltbNo):lTbls) def end sfs rem filterGroupSelect
makeAggLinks :: [(String,[String],String)] -> String -> String -> String -> Map String Int -> [String] -> NestedObject -> (Map String Int,String,String,String)
makeAggLinks sodn frmName toName aggName cnts (h1:h2:h3:h4:h5:h6:h7:t) nobj = completeAggLinks sodn (" FROM "++(if withSubSelection nobj then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++") AS "++frmName else h1++" AS "++frmName)++" INNER JOIN "++h5++" AS "++nxtTbl++" ON "++(makeEqColumns frmName (sepColString h2) nxtTbl (sepColString h6))) nxtTbl aggName toName frmName nxtCnt (h3:h4:h5:h6:h7:t)
where
nxtCnt = insertWith (+) h5 1 cnts
nxtTbl = (++) h5 $ show $ (!) nxtCnt h5
makeAggLinks sodn frmName toName aggName cnts (h1:h2:h3:h4:_) nobj = (nxtCnt,uniqCols++" FROM "++(if withSubSelection nobj then "(SELECT * FROM "++h1++" WHERE "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++") AS "++frmName else h1++" AS "++frmName)++" INNER JOIN "++h3++" AS "++nxtTbl++" ON "++(makeEqColumns frmName (sepColString h2) nxtTbl (sepColString h4))," GROUP BY "++uniqCols,makeEqColumns toName connIds aggName connIds)
where
nxtCnt = insertWith (+) h3 1 cnts
nxtTbl = (++) h3 $ show $ (!) nxtCnt h3
connIds = fetchTableIds h3 sodn
uniqCols = listIdFields nxtTbl connIds
makeAggLinks _ _ _ _ _ _ _ = throw RelationshipCardinalityException
listIdFields :: String -> [String] -> String
listIdFields nm ids = tail $ concat $ map (\nxt->","++nm++"."++nxt) ids
completeAggLinks :: [(String,[String],String)] -> String -> String -> String -> String -> String -> Map String Int -> [String] -> (Map String Int,String,String,String)
completeAggLinks sodn rlt prevTbl aggName toName frmName counts (h1:h2:h3:h4:h5:h6:h7:h8:t) = completeAggLinks sodn (rlt++" INNER JOIN "++h6++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h7))) nxtTbl aggName toName frmName nxtCnt (h1:h2:h6:h7:h8:t)
where
nxtCnt = insertWith (+) h6 1 counts
nxtTbl = (++) h6 $ show $ (!) nxtCnt h6
completeAggLinks sodn rlt prevTbl aggName toName frmName counts (h1:h2:h3:h4:h5:[]) = (nxtCnt,uniqCols++rlt++" INNER JOIN "++h1++" AS "++nxtTbl++" ON "++(makeEqColumns prevTbl (sepColString h5) nxtTbl (sepColString h2))," GROUP BY "++uniqCols,makeEqColumns toName connIds aggName connIds)
where
nxtCnt = insertWith (+) h1 1 counts
nxtTbl = (++) h1 $ show $ (!) nxtCnt h1
connIds = fetchTableIds h1 sodn
uniqCols = listIdFields nxtTbl connIds
completeAggLinks _ _ _ _ _ _ _ _ = throw RelationshipCardinalityException
sepColString :: String -> [String]
sepColString str = if elem ' ' str then foldl' (\(h:t) nChar->if nChar==' ' then ("":h:t) else ((h++[nChar]):t)) [""] str else [str]
addAggSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> FlagNode -> [FlagNode] -> Int -> Bool -> [(Int,Int,Bool,String)] -> [(Int,Int,Bool,String)] -> [(String,String,String)] -> [(String,String,String)] -> ([[(Int,Int,Bool,String)]],[[String]])
addAggSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs
addAggSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs
addAggSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs
where
(prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss
addAggSqlQueryFields ((Right (Left h)):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val nds) retFlgs lvl True li ri lqs rqs = if tablesLen>=1 then (fstTbls++(concat nxtTbls),fstQrys++(concat nxtQrys)) else addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa (FlagNode val (tail nds)) retFlgs lvl True li ((2,newLvl,True," "):ri) lqs (("","","SELECT * FROM (VALUES (NULL)) WHERE 1=0"):rqs)
where
tables = translateServerObjectToDBName (getServerObject h) sodn soa
tablesLen = length tables
(firstTableIds, firstTable) = head tables
(firstTableNewCounts,transition) = makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable firstTable sor) h
firstTableNum = (!) firstTableNewCounts firstTable
firstTableName = (++) firstTable $ show firstTableNum
newLvl = lvl+1
objSfs = getSubFields h
(fstTbls,fstQrys) = if firstNodeFlg<2 then
addAggSqlQueryFields t firstTableNewCounts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa retNode retFlgs lvl True li ((firstNodeFlg,lvl+1,True,firstTable):ri) lqs (("","",aggQry):rqs)
else
addAggSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++transition) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa (head nds) (retNode:retFlgs) newLvl True (li++[(val,lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from)]++rqs) []
where
aggQry = makeSqlAggQuery sss sodn sor soa firstTableNewCounts [(firstTable,firstTableNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids firstTableIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(drop 7 ids)++(listIdFields firstTableName (fetchTableIds firstTable sodn))++") SELECT * FROM result0")
firstNodeFlg = (\(FlagNode val _)->val) (head nds)
retNode = FlagNode val $ drop tablesLen nds
(nxtTbls,nxtQrys) = unzip $ map (\((FlagNode nVal nNds),(xIds,x))->let
(newCounts,transition)=makeTransitions ((++) ltable $ show ltableNo) counts (getDBObjectRelationships ltable x sor) h
xNum=(!) newCounts x
xName=x++(show xNum)
(nInfo,nQrs) = if nVal<2 then
addAggSqlQueryFields [] counts ids select from ((ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode val []) emptyFlgs lvl False flsLRcds ((nVal,newLvl,True,x):flsRRcds) lStubQrys (("","",aggQry):rStubQrys)
else
addAggSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++transition) ((x,xNum):(ltable,ltableNo):names) emptyFlds sss sodn sor soa (FlagNode nVal nNds) ((FlagNode val []):emptyFlgs) newLvl True (flsLRcds++[(val,lvl,False,ltable)]) flsRRcds lStubQrys rStubQrys
where
aggQry = makeSqlAggQuery sss sodn sor soa newCounts [(x,xNum)] ("result0 AS ("++(foldl' (\rlt _->rlt++"0,") ids xIds)++"JSON_GROUP_ARRAY(JSON_OBJECT(") ("))"++from++transition) objSfs [] (" GROUP BY "++(init $ drop 7 ids)++") SELECT * FROM result0")
emptyFlds = ([]:[[] | _<-fields])
emptyFlgs = [FlagNode sVal [] | (FlagNode sVal _)<-retFlgs]
flsLRcds = (map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) li)
flsRRcds = map (\(nVal,nlvl,_,ntbl)->(nVal,nlvl,False,ntbl)) ri
lStubQrys = [("","","") | _<-flsLRcds]
rStubQrys = [("","","") | _<-flsRRcds]
in
(nInfo,nQrs)) $ tail $ zip nds tables
addAggSqlQueryFields [] _ ids select from ((ltbl,_):_) [] _ _ _ _ (FlagNode val _) retFlgs lvl True li ri lqs rqs = ([li++(map snd nri)],[lQrs++rQrs])
where
(nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,True,ltbl):ri)) ((ids,select,from):rqs)
lQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-lqs]
rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]
addAggSqlQueryFields [] counts ids select from ((ltbl,_):b) (h:t) sss sodn sor soa (FlagNode val _) retFlgs lvl True li ri lqs rqs = addAggSqlQueryFields h counts nids sel frm b t sss sodn sor soa (head retFlgs) (tail retFlgs) nlvl nfst nli nri (init lqs) nrqs
where
(_,nlvl,nfst,_) = last li
(nids,sel,frm) = last lqs
nrqs = (ids,select,from):rqs
nli = init li
nri = (val,lvl,True,ltbl):ri
addAggSqlQueryFields _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ (FlagNode val _) _ lvl False li ri _ rqs = ([li++(map snd nri)],[rQrs])
where
(nri,nrqs) = unzip $ reverseNeighbourQueries $ zip (map (\(nf,nl,nb,nt)->(nl,(nf,nl,nb,nt))) ((val,lvl,False,ltable):ri)) (("","",""):rqs)
rQrs = [(removeLastChar (nids++sel))++frm++";" | (nids,sel,frm)<-filter ((/=) ("","","")) nrqs]
addAggSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs
| isServerObjectTable ltable ifo sodn soa = addAggSqlQueryFields (sfs++t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl True li ri lqs rqs
addAggSqlQueryFields (_:t) counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs = addAggSqlQueryFields t counts ids select from ((ltable,ltableNo):names) fields sss sodn sor soa flgs retFlgs lvl fst li ri lqs rqs
addAggSqlQueryFields _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ _ _ = error "Cannot find object for fields (source error)."