module Components.QueryComposers.SQLQueryComposer (makeSqlQueries) 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(..) ) import Model.ServerExceptions ( QueryException ( CreatingSqlQueryObjectsException, CreatingSqlQueryObjectFieldsException, InvalidObjectException, InvalidScalarException, RelationshipConfigurationException, InvalidArgumentException ) ) import Components.ObjectHandlers.ObjectsHandler ( translateServerObjectToDBName, getSubSelectionArgument, getSubSelectionField, withSubSelection, getDBObjectRelationships, getServerObject, isServerObjectTable, getSubFields, translateTableToObject ) 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)]) where dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa (firstIds,firstTable) = head dbNames firstTableName = firstTable++(show 1) -- 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 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) where tables = translateServerObjectToDBName (getServerObject h) sodn soa (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 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 removeLastChar "" = "" removeLastChar str = init str -- get the tables where we need to increment the tables counter 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) makeTransitions :: Map String Int -> [String] -> NestedObject -> String makeTransitions counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = " left join "++h5++" as "++h5++table5NumStr++" on "++(makeEqColumns (h1++(show $ (!) counts h1)) h2 (h5++table5NumStr) h6)++(completeTransition counts (h3:h4:h5:h6:h7:t) nobj) where table5NumStr = show $ (!) counts h5 makeTransitions counts (h1:h2:h3:h4:t) nobj = " left join "++(if (withSubSelection nobj)==True then "(select * from "++h3++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h3)++" as "++h3++table3NumStr++" on "++(makeEqColumns (h1++(show $ (!) counts h1)) h2 (h3++table3NumStr) h4) where 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 _ _ = throw RelationshipConfigurationException makeEqColumns :: String -> String -> String -> String -> String makeEqColumns tb1 col1 tb2 col2 = if (elem ' ' col1)==False&&(elem ' ' col2)==False then tb1++"."++col1++"="++tb2++"."++col2 else makeEqColumnsHelper "" tb1 col1 tb2 col2 makeEqColumnsHelper :: String -> String -> String -> String -> String -> String makeEqColumnsHelper rlt tb1 col1 tb2 col2 | (elem ' ' col1)&&(elem ' ' col2)&&(length rlt)>0 = makeEqColumnsHelper (rlt++" and "++tb1++"."++fst++"="++tb2++"."++snd) tb1 rmd1 tb2 rmd2 | (elem ' ' col1)&&(elem ' ' col2) = makeEqColumnsHelper (tb1++"."++fst++"="++tb2++"."++snd) tb1 rmd1 tb2 rmd2 | (elem ' ' col1) = throw RelationshipConfigurationException | (elem ' ' col2) = throw RelationshipConfigurationException | (length rlt)>0 = rlt++" and "++tb1++"."++col1++"="++tb2++"."++col2 | otherwise = tb1++"."++col1++"="++tb2++"."++col2 where (fst, rmd1) = getFirstColumn col1 (snd, rmd2) = getFirstColumn col2 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 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 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 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 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 makeTableIdentifier :: String -> [String] -> String -> String makeTableIdentifier _ [] _ = [] makeTableIdentifier tbl (h:[]) ins = tbl++"."++h++ins makeTableIdentifier tbl (h:t) ins = tbl++"."++h++ins++","++(makeTableIdentifier tbl t ins)