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])] -> ([[[(Int,Bool,String)]]],[[[String]]])
makeSqlQueries rojs sss sodn sor soa = unzip [makeSqlQuerySet sss sodn sor soa robj | robj<-rojs]
makeSqlQuerySet :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> RootObject -> ([[(Int,Bool,String)]],[[String]]) -- [([(Int,String)],[String])] ([[(Int,String)]],[[String]])
makeSqlQuerySet sss sodn sor soa obj = if (length dbNames)==1 then firstResult else (foldl' (\(tbls,qrs) (ntbls,nqrs) -> (tbls++ntbls,qrs++nqrs)) firstResult [(addSqlQueryFields (getSubFields obj) (fromList [(x,1)]) ("select "++(makeTableIdentifier xName xIds "")) "" (" from"++(makeSqlTablePhrase obj x 1)) (" order by "++(makeTableIdentifier xName xIds " asc")) ((x,1):[]) [] sss sodn sor soa 0 True [] [] [] []) | (xIds,x)<-(tail dbNames), let xName=x++(show 1)])
                           where
                             dbNames = translateServerObjectToDBName (getServerObject obj) sodn soa
                             (firstIds,firstTable) = head dbNames
                             firstTableName = firstTable++(show 1)
                             firstResult = addSqlQueryFields (getSubFields obj) (fromList [(firstTable,1)]) ("select "++(makeTableIdentifier firstTableName firstIds "")) "" (" from"++(makeSqlTablePhrase obj firstTable 1)) (" order by "++(makeTableIdentifier firstTableName firstIds " asc")) (((firstTable,1):[])) [] sss sodn sor soa 0 True [] [] [] []
-- making table phrase when there is only one sql table
makeSqlTablePhrase :: NestedObject -> String -> Int -> String
makeSqlTablePhrase obj name number = if (withSubSelection obj)==True then " (select * from "++name++" where "++(getSubSelectionField obj)++"="++(getSubSelectionArgument obj)++") as "++name++numStr else " "++name++" as "++name++numStr
  where
    numStr = show number
-- make queries for object of one table (most common is first - PCA example)
addSqlQueryFields :: SubFields -> Map String Int -> String -> String -> String -> String -> [(String,Int)] -> [SubFields] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,String,[String])] -> [(String,[String],[String])] -> Int -> Bool -> [(Int,Bool,String)] -> [(Int,Bool,String)] -> [(String,String,String,String)] -> [(String,String,String,String)] -> ([[(Int,Bool,String)]],[[String]]) -- [[((Int,String),String)]]
addSqlQueryFields ((Left (ScalarType _ "__typename" _ _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
addSqlQueryFields ((Left (ScalarType _ name Nothing _)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++ltable++(show ltableNo)++"."++name++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
addSqlQueryFields ((Left (ScalarType _ name (Just trans) arg)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields t counts ids (select++prefix++ltable++(show ltableNo)++"."++name++suffix++",") from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
  where
    (prefix,suffix) = getPrimitiveScalarTypeArgumentOptions (translateTableToObject ltable sodn) name trans arg sss
-- since only difference is table name, I should remove repeated computations by changing only name.
addSqlQueryFields ((Right (Left h)):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
    | tablesLen>1 = foldl' (\(info,qrs) (xIds,x)-> let
        newCounts=calcNewCounts ltable x counts sor
        xNum=(!) newCounts x
        xName=x++(show xNum)
        (nInfo,nQrs) = addSqlQueryFields objSfs newCounts (ids++(makeTableIdentifier xName xIds "")) "" (from++(makeTransitions newCounts (getDBObjectRelationships ltable x sor) h)) (order++(makeTableIdentifier xName xIds " asc")) ((x,xNum):(ltable,ltableNo):names) emptiedFlds sss sodn sor soa newLvl True flsRcds [] [] []
      in
        (info++nInfo,qrs++nQrs)
      ) firstResult (tail tables)
    | tablesLen==1 = firstResult
  where
    tables = translateServerObjectToDBName (getServerObject h) sodn soa
    tablesLen = length tables
    (firstTableIds, firstTable) = head tables
    firstTableNewCounts = calcNewCounts ltable firstTable counts sor
    firstTableNum = (!) firstTableNewCounts firstTable
    firstTableName = firstTable++(show firstTableNum)
    newLvl = lvl+1
    objSfs = getSubFields h
    firstResult = addSqlQueryFields objSfs firstTableNewCounts (ids++(makeTableIdentifier firstTableName firstTableIds "")) "" (from++(makeTransitions firstTableNewCounts (getDBObjectRelationships ltable firstTable sor) h)) (order++(makeTableIdentifier firstTableName firstTableIds " asc")) ((firstTable,firstTableNum):(ltable,ltableNo):names) (t:fields) sss sodn sor soa newLvl True (li++[(lvl,True,ltable)]++ri) [] (lqs++[(ids,select,from,order)]++rqs) []
    emptiedFlds = ([]:[[] | _<-fields])
    flsRcds = (map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) li)++[(lvl,False,ltable)]++(map (\(nlvl,_,ntbl)->(nlvl,False,ntbl)) ri)
addSqlQueryFields [] _ ids select from order ((ltbl,_):_) [] _ _ _ _ lvl True li ri lqs rqs = ([li++((lvl,True,ltbl):ri)],[lQrs++(((removeLastChar (ids++select))++from++(removeLastChar order)++";"):rQrs)])
  where
    lQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-lqs]
    rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-rqs]
addSqlQueryFields [] counts ids select from order ((ltbl,_):b) (h:t) sss sodn sor soa lvl True li ri lqs rqs = addSqlQueryFields h counts nids sel frm ord b t sss sodn sor soa nlvl nfst nli nri (init lqs) nrqs
  where
    (nlvl,nfst,_) = last li
    (nids,sel,frm,ord) = last lqs
    nrqs = (ids,select,from,order):rqs
    nli = init li
    nri = (lvl,True,ltbl):ri
addSqlQueryFields _ _ _ _ _ _ ((ltable,_):_) _ _ _ _ _ lvl False li ri _ rqs = ([li++((lvl,False,ltable):ri)],[rQrs])
  where
    rQrs = [(removeLastChar (nids++sel))++frm++(removeLastChar ord)++";" | (nids,sel,frm,ord)<-rqs]
addSqlQueryFields ((Right (Right (InlinefragmentObject ifo sfs))):t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
    | isServerObjectTable ltable ifo sodn soa = addSqlQueryFields (sfs++t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl True li ri lqs rqs
addSqlQueryFields (_:t) counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs = addSqlQueryFields t counts ids select from order ((ltable,ltableNo):names) fields sss sodn sor soa lvl fst li ri lqs rqs
addSqlQueryFields _ _ _ _ _ _ [] _ _ _ _ _ _ _ _ _ _ _ = throw CreatingSqlQueryObjectFieldsException -- fields without objects
calcNewCounts :: String -> String -> Map String Int -> [(String,String,[String])] -> Map String Int
calcNewCounts from to pcnt sor = foldl' (\y x-> insertWith (+) x 1 y) pcnt $ getNewTables $ getDBObjectRelationships from to sor
removeLastChar :: String -> String
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 (h:t) 0 = h:getNewTablesHelper (tail t) 3
getNewTablesHelper (h:t) idx
    | ((mod idx 3)==0) = h:getNewTablesHelper t (idx+1)
    | otherwise = getNewTablesHelper t (idx+1)
getNewTablesHelper [] _ = []
makeTransitions :: Map String Int -> [String] -> NestedObject -> String
makeTransitions counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = " left join "++h5++" as "++h5++table5NumStr++" on "++(makeEqColumns (h1++(show $ (!) counts h1)) h2 (h5++table5NumStr) h6)++(completeTransition counts (h3:h4:h5:h6:h7:t) nobj)
  where
    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:h6:h7:h8:t) nobj = " left join "++h6++" as "++h6++table6NumStr++" on "++(makeEqColumns (h3++(show $ (!) counts h3)) h5 (h6++table6NumStr) h7)++(completeTransition counts (h1:h2:h6:h7:h8:t) nobj)
  where
    table6NumStr = show $ (!) counts h6
completeTransition counts (h1:h2:h3:h4:h5:[]) nobj = " left join "++(if (withSubSelection nobj)==True then "(select * from "++h1++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")" else h1)++" as "++h1++table1NumStr++" on "++(makeEqColumns (h3++(show $ (!) counts h3)) h5 (h1++table1NumStr) h2)
  where
    table1NumStr = show $ (!) counts h1
completeTransition counts _ _ = throw RelationshipConfigurationException
makeEqColumns :: String -> String -> String -> String -> String
makeEqColumns tb1 col1 tb2 col2 = if (elem ' ' col1)==False&&(elem ' ' col2)==False then tb1++"."++col1++"="++tb2++"."++col2 else makeEqColumnsHelper "" tb1 col1 tb2 col2
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 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)
 | h==obj = getScalarTypeArgumentsOptions st trans arg sts
 | otherwise = getPrimitiveScalarTypeArgumentOptions obj st trans arg rst
getPrimitiveScalarTypeArgumentOptions _ _ _ _ [] = throw InvalidObjectException
getScalarTypeArgumentsOptions :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> (String,String)
getScalarTypeArgumentsOptions st trans arg ((name,_,args):t)
 | st==name = getArgumentOptions trans arg args
 | otherwise = getScalarTypeArgumentsOptions st trans arg t
getScalarTypeArgumentsOptions _ _ _ [] = throw InvalidScalarException
getArgumentOptions :: String -> Argument -> [(String,[(String,String,String,String)])] -> (String,String)
getArgumentOptions trans arg ((aname,opts):rst)
 | trans==aname = getArgumentOption arg opts
 | otherwise = getArgumentOptions trans arg rst
getArgumentOptions _ _ [] = throw InvalidArgumentException
getArgumentOption :: Argument -> [(String,String,String,String)] -> (String,String)
getArgumentOption Nothing ((_,_,prefix,suffix):_) = (prefix,suffix)
getArgumentOption (Just opt) ((name,_,prefix,suffix):rst)
 | opt==name = (prefix,suffix)
 | otherwise = getArgumentOption (Just opt) rst
getArgumentOption _ [] = throw InvalidArgumentException
makeTableIdentifier :: String -> [String] -> String -> String
makeTableIdentifier tbl (fid:ids) ins = foldl' (\y x->y++tbl++"."++x++ins++",") [] (fid:ids)
makeTableIdentifier _ [] _ = []