module Components.QueryComposers.SQLQueryComposer (makeSqlQueries) where

import Data.Either
import qualified Data.Map.Strict as M
import qualified Control.Exception as E
import Model.ServerObjectTypes
import Model.ServerExceptions
import Components.ObjectHandlers.ObjectsHandler


makeSqlQueries :: [RootObject] -> [(String,[String])] -> [(String,String,[String])] -> [[String]]
makeSqlQueries [] _ _ = []
makeSqlQueries (h:t) sodn sor = (makeSqlQuerySet h sodn sor):(makeSqlQueries t sodn sor)
makeSqlQuerySet :: RootObject -> [(String,[String])] -> [(String,String,[String])] -> [String]
makeSqlQuerySet obj sodn sor = if (length dbNames)==1 then (addSqlQueryFields (getSubFields obj) (M.fromList [((head dbNames),1)]) ("select "++(head dbNames)++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj (head dbNames) 1)) (" order by "++(head dbNames)++(show 1)++".id asc") (((head dbNames)++(show 1)):[]) [] [(head dbNames)] sodn sor) else (foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields obj) (M.fromList [(x,1)]) ("select "++x++(show 1)++".id,") (" from"++(makeSqlTablePhrase obj x 1)) (" order by "++x++(show 1)++".id asc") ((x++(show 1)):[]) [] [x] sodn sor) | x<-dbNames])
                           where
                             dbNames = translateServerObjectToDBName (getServerObject obj) sodn
-- 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++(show number) else " "++name++" as "++name++(show number)
addSqlQueryFields :: SubFields -> M.Map String Int -> String -> String -> String -> [String] -> [SubFields] -> [String] -> [(String,[String])] -> [(String,String,[String])] -> [String]
addSqlQueryFields [] counts select from order [] [] ltable _ _ = [(removeLastChar select)++from++order++";"]
addSqlQueryFields [] counts select from order [] (h:t) ltable _ _ = E.throw CreatingSqlQueryObjectFieldsException
addSqlQueryFields [] counts select from order (h:t) [] ltable _ _ = [(removeLastChar select)++from++order++";"]
addSqlQueryFields [] counts select from order (a:b) (h:t) ltable sodn sor = addSqlQueryFields h counts select from order b t ltable sodn sor
addSqlQueryFields (h:t) counts select from order [] [] ltable _ _ = E.throw CreatingSqlQueryObjectsException
addSqlQueryFields (h:t) counts select from order [] (a:b) ltable _ _ = E.throw CreatingSqlQueryObjectsException
addSqlQueryFields (h:t) counts select from order names fields ltable sodn sor
    | (isLeft h)==True = addSqlQueryFields t counts (select++(head names)++"."++(getScalarName $ fromLeft (E.throw InvalidScalarException) h)++",") from order names fields ltable sodn sor
    -- since only difference is table name, I should remove repeated computations by changing only name...
    | tablesCount>1 = foldr (\x y -> x++y) [] [(addSqlQueryFields (getSubFields nobj) (calcNewCounts (head ltable) x) (select++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id,") (from++(makeTransitions (calcNewCounts (head ltable) x) (getDBObjectRelationships (head ltable) x sor) nobj)) (order++","++x++(show $ (M.!) (calcNewCounts (head ltable) x) x)++".id asc") ((x++(show $ (M.!) (calcNewCounts (head ltable) x) x)):names) (t:fields) [x] sodn sor) | x<-tables]
    | otherwise = addSqlQueryFields (getSubFields nobj) (calcNewCounts (head ltable) $ head tables) (select++(head tables)++(show $ (M.!) (calcNewCounts (head ltable) $ head tables) (head tables))++".id,") (from++(makeTransitions (calcNewCounts (head ltable) $ head tables) (getDBObjectRelationships (head ltable) (head tables) sor) nobj)) (order++","++(head tables)++(show $ (M.!) (calcNewCounts (head ltable) $ head tables) (head tables))++".id asc") (((head tables)++(show ((calcNewCounts (head ltable) $ head tables) M.! (head tables)))):names) (t:fields) [(head tables)] sodn sor
  where
    calcNewCounts :: String -> String -> M.Map String Int
    calcNewCounts from to = foldr (\x y -> M.insertWith (+) x 1 y) counts (getNewTables $ getDBObjectRelationships from to sor)
    nobj = fromRight (E.throw InvalidObjectException) h
    sobj = getServerObject nobj
    tablesCount = length tables
    tables = translateServerObjectToDBName sobj sodn
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) idx
    | (idx==0) = h:getNewTablesHelper (tail t) 3
    | ((mod idx 3)==0) = h:getNewTablesHelper t (idx+1)
    | otherwise = getNewTablesHelper t (idx+1)
makeTransitions :: M.Map String Int -> [String] -> NestedObject -> String
makeTransitions counts (h1:h2:h3:h4:h5:h6:h7:t) nobj = " inner join "++h5++" as "++h5++(show $ (M.!) counts h5)++" on "++h1++(show $ (M.!) counts h1)++"."++h2++"="++h5++(show $ (M.!) counts h5)++"."++h6++(completeTransition counts (h3:h4:h5:h6:h7:t) nobj)
makeTransitions counts (h1:h2:h3:h4:t) nobj = " inner join "++(if (withSubSelection nobj)==True then ("(select * from "++h3++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")") else h3)++" as "++h3++(show $ (M.!) counts h3)++" on "++h1++(show $ (M.!) counts h1)++"."++h2++"="++h3++(show $ (M.!) counts h3)++"."++h4
makeTransitions _ _ _ = E.throw RelationshipConfigurationException
completeTransition :: M.Map String Int -> [String] -> NestedObject -> String
completeTransition counts (h1:h2:h3:h4:h5:[]) nobj = " inner join "++(if (withSubSelection nobj)==True then ("(select * from "++h1++" where "++(getSubSelectionField nobj)++"="++(getSubSelectionArgument nobj)++")") else h1)++" as "++h1++(show $ (M.!) counts h1)++" on "++h3++(show $ (M.!) counts h3)++"."++h5++"="++h1++(show $ (M.!) counts h1)++"."++h2
completeTransition counts (h1:h2:h3:h4:h5:h6:h7:h8:t) nobj = " inner join "++h6++" as "++h6++(show $ (M.!) counts h6)++" on "++h3++(show $ (M.!) counts h3)++"."++h5++"="++h6++(show $ (M.!) counts h6)++"."++h7++(completeTransition counts (h1:h2:h6:h7:h8:t) nobj)
completeTransition counts _ _ = E.throw RelationshipConfigurationException