module Components.DataProcessors.ListDataProcessor (processReturnedValues) where


import Model.ServerExceptions (
        QueryException(
            InvalidObjectException,
            InvalidScalarException,
            InvalidArgumentException,
            EOFDataProcessingException,
            InvalidVariableTypeException,
            InvalidObjectScalarFieldException
        )
    )
import Model.ServerObjectTypes (NestedObject(..),Field,RootObject)
import Components.ObjectHandlers.ObjectsHandler (
        getSubFields,
        getServerObject,
        getInlinefragmentFields,
        getInlinefragmentObject,
        translateServerObjectToDBName,
        isServerObjectTable,
        getNestedObjectFieldLabel,
        getScalarName,
        getScalarFieldLabel,
        getServerObjectScalars,
        translateTableToObject
    )
import Data.Maybe (Maybe(Nothing),fromJust)
import Data.Either (fromRight,fromLeft,isLeft)
import Data.Text (Text,unpack,pack)
import Text.JSON (showJSON,showJSONs,JSValue,JSObject,toJSObject,encodeStrict)
import Control.Exception (throw)


-- with root objects we want one json representation of separate graphql results...
processReturnedValues :: [(String,[(String,String)])] -> [(String,String)] -> [(String,[String],[String])] -> [RootObject] -> [[[String]]] -> [[[[Text]]]] -> String
processReturnedValues sss sodn soa robjs tbls rlts = encodeStrict $ processReturnedValuesToJsonObject sss sodn soa robjs tbls rlts
processReturnedValuesToJsonObject :: [(String,[(String,String)])] -> [(String,String)] -> [(String,[String],[String])] -> [RootObject] -> [[[String]]] -> [[[[Text]]]] -> JSObject (JSObject JSValue)
processReturnedValuesToJsonObject sss sodn soa robjs tbls rlts = toJSObject [("data", toJSObject [processReturnedValue sss sodn soa x y z | (x,y,z) <- zip3 robjs tbls rlts])]
-- with qraphql query object and sql return data, we want json representation on graphql query results...
processReturnedValue :: [(String,[(String,String)])] -> [(String,String)] -> [(String,[String],[String])] -> RootObject -> [[String]] -> [[[Text]]] -> (String, JSValue)
processReturnedValue sss sodn soa (NestedObject alias name sobj _ sfs) tbls rlts = (if (alias==Nothing) then name else (fromJust alias), showJSONs $ processSubFields sss sodn soa sobj tbls sfs rlts)
-- with SubFields and data rows, we want json representation on qraphql query data
processSubFields :: [(String,[(String,String)])] -> [(String,String)] -> [(String,[String],[String])] -> String -> [[String]] -> [Field] -> [[[Text]]] -> [JSValue]
processSubFields _ _ _ _ _ _ [] = []
processSubFields _ _ _ _ _ [] _ = []
-- are the query results from unique objects to make separate objects
-- assume that if last table is same, fetchNextRow is same object instance
processSubFields sss sodn soa sobj tbls sfs rlts
    | (null $ foldr (++) [] rlts)==True = []
    | sameTables&&(null object)==False = (showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls sfs [removeDataRow x | x<-rlts])
    | sameTables = processSubFields sss sodn soa sobj tbls sfs [removeDataRow x | x<-rlts]
    | otherwise = [showJSON $ toJSObject x | x<-objects, (null x)==False]++(processSubFields sss sodn soa sobj tbls sfs [removeDataRow x | x<-rlts])
  where
    sameTables = (foldr (\x y->(last x)==(last $ head tbls)&&y) True tbls)
    object = makeOneGQLObject sss sodn soa sobj tbls sfs [fetchGraphQlRow x | x<-rlts]
    -- assume tbls are segmented from last table
    groupedData :: [[([String],[[Text]])]]
    groupedData = foldr (\(x,y) z -> if (null z)==True then [[(x,y)]] else if (last x)==(last $ fst $ head $ head z) then (((x,y):(head z)):(tail z)) else ([(x,y)]:z)) [] $ zip tbls [fetchGraphQlRow x | x<-rlts]
    objects = foldr (\x y -> (makeOneGQLObject sss sodn soa sobj [i | (i,_)<-x] sfs [j | (_,j)<-x]):y) [] groupedData
-- assume all last elements are same in tbls
-- assume all instances (ist) are same
makeOneGQLObject :: [(String,[(String,String)])] -> [(String,String)] -> [(String,[String],[String])] -> String -> [[String]] -> [Field] -> [[[Text]]] -> [(String,JSValue)]
makeOneGQLObject _ _ _ _ _ [] (([]:_):_) = []  -- done
makeOneGQLObject _ _ _ _ _ _ ([]:_) = []  -- no data
makeOneGQLObject _ _ _ _ _ _ [] = []  -- no queries (unusual)
makeOneGQLObject _ _ _ _ _ [] _ = throw EOFDataProcessingException  -- columns and no fields
makeOneGQLObject _ _ _ _ [] _ _ = throw EOFDataProcessingException  -- no reference tables (unusual)
makeOneGQLObject _ sodn soa sobj tbls (f:[]) (([]:_):_)  -- field and no result columns
    | (isLeft f)==True&&scalarName=="__typename" = (getScalarFieldLabel scalarField, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):[]
    | (isLeft f)==True||(isLeft fo)==True||(isServerObjectTable (last $ head tbls) (getInlinefragmentObject ifo) sodn soa)==False = []
    | otherwise = throw EOFDataProcessingException
  where
    scalarField = fromLeft (throw InvalidScalarException) f
    scalarName = getScalarName scalarField
    fo = fromRight (throw InvalidObjectException) f
    ifo = fromRight (throw InvalidObjectException) fo
makeOneGQLObject _ _ _ _ _ _ (([]:_):_) = throw EOFDataProcessingException  -- fields and no result columns
makeOneGQLObject sss sodn soa sobj tbls (a:b) (((i:j):k):l)  -- (((:fld):ist):qry)
    | (isLeft a)==True&&(scalarName=="__typename") = ((getScalarFieldLabel scalarField, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):(makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l)))
    | (isLeft a)==True = ((getScalarFieldLabel scalarField, castJSType (getServerObjectScalars sobj sss soa) scalarName i):(makeOneGQLObject sss sodn soa sobj tbls b [removeNDataColumns 1 x | x<-(((i:j):k):l)]))
    | (isLeft fo)==True = (((getNestedObjectFieldLabel no), showJSONs (processSubFields sss sodn soa (getServerObject no) nxtTbls (getSubFields no) [pullNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)])):(makeOneGQLObject sss sodn soa sobj [updateTables (countNOTables sodn soa no x) x | x<-tbls] b [removeNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)]))
    | (isServerObjectTable (last $ head tbls) (getInlinefragmentObject ifo) sodn soa)==True = makeOneGQLObject sss sodn soa sobj tbls ((getInlinefragmentFields ifo)++b) (((i:j):k):l)
    | otherwise = makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l)
  where
    nxtTbls = map init tbls
    nestedObjectFieldCounts = map (\x -> countNOQueriedFields sodn soa no x) nxtTbls
    scalarField = (fromLeft (throw InvalidScalarException) a)
    scalarName = getScalarName scalarField
    fo = fromRight (throw InvalidObjectException) a
    no = fromLeft (throw InvalidObjectException) fo
    ifo = fromRight (throw InvalidObjectException) fo
fetchGraphQlRow :: [[Text]] -> [[Text]]
fetchGraphQlRow rlts = if (head $ head rlts)==(pack "Unexpected null") then [] else [t | (h:t)<-rlts, (h==(head $ head rlts))&&((head t)==(head $ tail $ head rlts))]
removeDataRow :: [[Text]] -> [[Text]]
removeDataRow rlts = [x | x<-rlts, (head x)/=(head $ head rlts)||((head $ tail x)/=(head $ tail $ head rlts))]
pullNDataColumns :: Int -> [[Text]] -> [[Text]]
pullNDataColumns _ [] = []
pullNDataColumns cnt rslt
    | (cnt<0) = throw InvalidArgumentException
    | otherwise = map (\x -> if (length x)<cnt then (throw EOFDataProcessingException) else (take cnt x)) rslt
-- count how many columns are added to sql data result for this nested object including the nested object id
countNOQueriedFields :: [(String,String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int
countNOQueriedFields sodn soa (NestedObject alias name sobj ss sfs) tbls = 1+(countNOQueriedSubFields sodn soa sfs tbls)
countNOQueriedSubFields :: [(String,String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int
countNOQueriedSubFields _ _ [] _ = 0
countNOQueriedSubFields sodn soa (h:t) tbls
    | (isLeft h)==True&&scalarName=="__typename" = countNOQueriedSubFields sodn soa t tbls
    | (isLeft h)==True = 1+(countNOQueriedSubFields sodn soa t tbls)
    | (isLeft fo)==True = (countNOQueriedFields sodn soa no $ init tbls)+(countNOQueriedSubFields sodn soa t tbls)
    | (isServerObjectTable (last tbls) (getInlinefragmentObject ifo) sodn soa)==True = countNOQueriedSubFields sodn soa ((getInlinefragmentFields ifo)++t) tbls
    | otherwise = countNOQueriedSubFields sodn soa t tbls
  where
    scalarName = getScalarName $ fromLeft (throw InvalidScalarException) h
    fo = fromRight (throw InvalidObjectException) h
    no = fromLeft (throw InvalidObjectException) fo
    ifo = fromRight (throw InvalidObjectException) fo
-- remove nested object columns from data row that is including nested object id
removeNDataColumns :: Int -> [[Text]] -> [[Text]]
removeNDataColumns 0 rslt = rslt
removeNDataColumns (-1) _ = throw EOFDataProcessingException
removeNDataColumns _ [[]] = [[]]
removeNDataColumns _ ([]:t) = throw EOFDataProcessingException
removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt]
castJSType :: [(String,String)] -> String -> Text -> JSValue
castJSType [] fld val = throw InvalidObjectScalarFieldException
castJSType ((nam,typ):t) fld val
    | (nam==fld)&&(typ=="Text") = showJSON val
    | (nam==fld)&&(typ=="ByteString") = showJSON val
    | (nam==fld)&&(typ=="Int") = showJSON (Prelude.read $ unpack val :: Int)
    | (nam==fld)&&(typ=="Double") = showJSON (Prelude.read $ unpack val :: Double)
    | (nam==fld)&&(typ=="Rational") = showJSON (Prelude.read $ unpack val :: Double)
    | (nam==fld)&&(typ=="Bool") = showJSON (Prelude.read $ unpack val :: Int)
    | (nam==fld)&&(typ=="Day") = showJSON val
    | (nam==fld)&&(typ=="TimeOfDay") = showJSON val
    | (nam==fld)&&(typ=="UTCTime") = showJSON val
    | (nam==fld) = throw InvalidVariableTypeException
    | otherwise = castJSType t fld val
countNOTables :: [(String,String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int
countNOTables sodn soa (NestedObject alias name sobj ss sfs) tbls = 1+(countSubfieldsTables sodn soa sfs tbls)
countSubfieldsTables :: [(String,String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int
countSubfieldsTables _ _ [] _ = 0
countSubfieldsTables sodn soa (h:t) tbls
    | (isLeft h)==True = countSubfieldsTables sodn soa t tbls
    | (isLeft fo)==True = foCount+(countSubfieldsTables sodn soa t (updateTables foCount tbls))
    | (isServerObjectTable (last tbls) (getInlinefragmentObject ifo) sodn soa)==True = countSubfieldsTables sodn soa ((getInlinefragmentFields ifo)++t) tbls
    | otherwise = countSubfieldsTables sodn soa t tbls
  where
    fo = fromRight (throw InvalidObjectException) h
    no = fromLeft (throw InvalidObjectException) fo
    foCount = countNOTables sodn soa no (init tbls)
    ifo = fromRight (throw InvalidObjectException) fo
updateTables :: Int -> [String] -> [String]
updateTables 0 rlt = rlt
updateTables _ [] = throw EOFDataProcessingException
updateTables n lst
    | n<0 = throw InvalidArgumentException
    | otherwise = updateTables (n-1) ((init $ init lst)++[last lst] )