module Components.DataProcessors.ListDataProcessor (processReturnedValues) where

import Data.Text (Text,unpack,pack)
import Text.JSON (showJSON,showJSONs,JSValue,JSObject,toJSObject,encodeStrict)
import Control.Exception (throw)
import Data.List (foldl')
import Model.ServerExceptions (
        QueryException(
            InvalidObjectException,
            InvalidScalarException,
            InvalidArgumentException,
            EOFDataProcessingException,
            InvalidVariableTypeException
        )
    )
import Model.ServerObjectTypes (
    NestedObject(..),
    Field,
    RootObject,
    ServerObject,
    ScalarType(..),
    Transformation,
    Argument,
    InlinefragmentObject(..)
  )
import Components.ObjectHandlers.ObjectsHandler (
      isServerObjectTable,
      getNestedObjectFieldLabel,
      getScalarFieldLabel,
      translateTableToObject
  )


-- with root objects we want one json representation of separate graphql results...
processReturnedValues :: [(String,[(String,String,[(String,[(String,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)])])])] -> [(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)])])])] -> [(String,String)] -> [(String,[String],[String])] -> RootObject -> [[String]] -> [[[Text]]] -> (String, JSValue)
processReturnedValue sss sodn soa (NestedObject Nothing name sobj _ sfs) tbls rlts = (name, showJSONs $ processSubFields sss sodn soa sobj tbls sfs rlts)
processReturnedValue sss sodn soa (NestedObject (Just alias) name sobj _ sfs) tbls rlts = (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)] -> [(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 = foldl' (\y x->(last x)==(last $ head tbls)&&y) True tbls
    object = makeOneGQLObject sss sodn soa sobj tbls sfs [fetchGraphQlRow x | x<-rlts]
    -- different tables is possibly different result rows. I should not assume that they are same.
    notEmptyQueryResults = [(x,y) | (x,y)<-zip tbls rlts, null y==False]
    -- 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)) [] $ [(x,fetchGraphQlRow y) | (x,y)<-notEmptyQueryResults]
    labeledData = [unzip x | x<-groupedData]
    objects = foldr (\(x,y) z -> (makeOneGQLObject sss sodn soa sobj x sfs y):z) [] labeledData
-- 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)] -> [(String,[String],[String])] -> String -> [[String]] -> [Field] -> [[[Text]]] -> [(String,JSValue)]
makeOneGQLObject _ _ _ _ _ [] (([]:_):_) = []  -- done
makeOneGQLObject _ _ _ _ _ _ ([]:_) = []  -- no column data
makeOneGQLObject _ _ _ _ _ _ [] = []  -- no queries (unusual)
makeOneGQLObject _ _ _ _ _ [] _ = throw EOFDataProcessingException  -- columns and no fields
makeOneGQLObject _ _ _ _ [] _ _ = throw EOFDataProcessingException  -- no reference tables (unusual)
makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):[]) (([]:_):_) = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):[]  -- field and no result columns
-- makeOneGQLObject _ _ _ _ _ ((Left _):[]) (([]:_):_) = []  -- field and no result columns (unusual)
-- makeOneGQLObject _ _ _ _ _ ((Right (Left _)):[]) (([]:_):_) = []  -- field and no result columns (unusual)
makeOneGQLObject sss sodn soa _ tbls (Right (Right (InlinefragmentObject ifo sfs)):[]) (([]:_):_)
 | (isServerObjectTable (last $ head tbls) ifo sodn soa)==False = []  -- field and no result columns
makeOneGQLObject _ _ _ _ _ (_:[]) (([]:_):_) = throw EOFDataProcessingException  -- field and no result columns
makeOneGQLObject _ _ _ _ _ _ (([]:_):_) = throw EOFDataProcessingException  -- fields and no result columns
makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) (((i:j):k):l) = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (last $ head $ tbls) sodn):(makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l))  -- (((:fld):ist):qry)
makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) (((i:j):k):l) = (getScalarFieldLabel $ ScalarType alias name trans arg, castJSType (findPrimitiveScalarTypeType (translateTableToObject (last $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObject sss sodn soa sobj tbls b [removeNDataColumns 1 x | x<-(((i:j):k):l)])
makeOneGQLObject sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) (((i:j):k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs (processSubFields sss sodn soa nso nxtTbls sfs [pullNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)])):(makeOneGQLObject sss sodn soa sobj [updateTables (countNOTables sodn soa (NestedObject alias name nso ss sfs) x) x | x<-tbls] b [removeNDataColumns x y | (x,y)<-zip nestedObjectFieldCounts (((i:j):k):l)])
  where
    nxtTbls = [init x | x<-tbls]
    nestedObjectFieldCounts = [countQueriedSubFields sodn soa (NestedObject alias name nso ss sfs) x | x<-nxtTbls]
makeOneGQLObject sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) (((i:j):k):l)
 | (isServerObjectTable (last $ head tbls) ifo sodn soa)==True = makeOneGQLObject sss sodn soa sobj tbls (sfs++b) (((i:j):k):l)
makeOneGQLObject sss sodn soa sobj tbls (_:b) (((i:j):k):l) = makeOneGQLObject sss sodn soa sobj tbls b (((i:j):k):l)

findPrimitiveScalarTypeType :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> String
findPrimitiveScalarTypeType _ _ _ _ [] = throw InvalidObjectException
findPrimitiveScalarTypeType sobj name trans arg ((obj,flds):rst)
 | sobj==obj = findScalarTypeType name trans arg flds
 | otherwise = findPrimitiveScalarTypeType sobj name trans arg rst
findScalarTypeType :: String -> Transformation -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> String
findScalarTypeType _ _ _ [] = throw InvalidScalarException
findScalarTypeType name Nothing _ ((sName,sType,opts):rst)
 | name==sName = sType
 | otherwise = findScalarTypeType name Nothing Nothing rst
findScalarTypeType name (Just trans) arg ((sName,sType,args):rst)
 | name==sName = findArgumentOptionType trans arg args
 | otherwise = findScalarTypeType name (Just trans) arg rst
findArgumentOptionType :: String -> Argument -> [(String,[(String,String,String,String)])] -> String
findArgumentOptionType _ _ [] = throw InvalidArgumentException
findArgumentOptionType trans Nothing ((aname,[]):rst)
 | trans==aname = throw InvalidArgumentException
 | otherwise = findArgumentOptionType trans Nothing rst
findArgumentOptionType trans Nothing ((aname,((_,typ,_,_):_)):rst)
 | trans==aname = typ
 | otherwise = findArgumentOptionType trans Nothing rst
findArgumentOptionType trans (Just arg) ((aname,opts):rst)
 | trans==aname = findOptionType arg opts
 | otherwise = findArgumentOptionType trans (Just arg) rst
findOptionType :: String -> [(String,String,String,String)] -> String
findOptionType _ [] = throw InvalidArgumentException
findOptionType arg ((oname,typ,_,_):rst)
 | arg==oname = typ
 | otherwise = findOptionType arg rst

fetchGraphQlRow :: [[Text]] -> [[Text]]
fetchGraphQlRow rlts = if (head $ head rlts)==(pack "Unexpected null") then [] else [t | (h:t)<-rlts, h==(head $ head rlts)]
removeDataRow :: [[Text]] -> [[Text]]
removeDataRow rlts = [x | x<-rlts, (head x)/=(head $ head rlts)]
pullNDataColumns :: Int -> [[Text]] -> [[Text]]
pullNDataColumns _ [] = []
pullNDataColumns cnt rslt
 | (cnt<0) = throw InvalidArgumentException
 | otherwise = [if (length x)<cnt then throw EOFDataProcessingException else take cnt x | x<-rslt]
-- count how many columns are added to sql data result for this nested object including the nested object id
countQueriedSubFields :: [(String,String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int
countQueriedSubFields sodn soa (NestedObject alias name sobj ss sfs) tbls = countQueriedSubFieldsHelper sodn soa sfs tbls 1
countQueriedSubFieldsHelper :: [(String,String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int -> Int
countQueriedSubFieldsHelper _ _ [] _ acc = acc
countQueriedSubFieldsHelper sodn soa ((Left (ScalarType _ "__typename" _ _)):t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls acc
countQueriedSubFieldsHelper sodn soa ((Left (ScalarType _ _ _ _)):t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls (acc+1)
countQueriedSubFieldsHelper sodn soa ((Right (Left (NestedObject _ _ _ _ sfs))):t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls (acc+(countQueriedSubFieldsHelper sodn soa sfs (init tbls) 1))
countQueriedSubFieldsHelper sodn soa ((Right (Right (InlinefragmentObject ifo sfs))):t) tbls acc
 | (isServerObjectTable (last tbls) ifo sodn soa)==True = countQueriedSubFieldsHelper sodn soa (sfs++t) tbls acc
countQueriedSubFieldsHelper sodn soa (_:t) tbls acc = countQueriedSubFieldsHelper sodn soa t tbls acc

-- 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 _ [[]] = throw EOFDataProcessingException  -- [[]]
removeNDataColumns _ ([]:_) = throw EOFDataProcessingException
removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt]
castJSType :: String -> Text -> JSValue
castJSType "Text" val = showJSON val
castJSType "ByteString" val = showJSON val
castJSType "Int" val = showJSON (Prelude.read $ unpack val :: Int)
castJSType "Double" val = showJSON (Prelude.read $ unpack val :: Double)
castJSType "Rational" val = showJSON (Prelude.read $ unpack val :: Double)
castJSType "Bool" val = showJSON (Prelude.read $ unpack val :: Int)
castJSType "Day" val = showJSON val
castJSType "TimeOfDay" val = showJSON val
castJSType "UTCTime" val = showJSON val
castJSType _ val = throw InvalidVariableTypeException
countNOTables :: [(String,String)] -> [(String,[String],[String])] -> NestedObject -> [String] -> Int
countNOTables sodn soa (NestedObject alias name sobj ss sfs) tbls = countSubfieldsTables sodn soa sfs tbls 1
countSubfieldsTables :: [(String,String)] -> [(String,[String],[String])] -> [Field] -> [String] -> Int -> Int
countSubfieldsTables _ _ [] _ acc = acc
countSubfieldsTables sodn soa ((Left _):t) tbls acc = countSubfieldsTables sodn soa t tbls acc
countSubfieldsTables sodn soa ((Right (Left h)):t) tbls acc = countSubfieldsTables sodn soa t (updateTables foCount tbls) (acc+foCount)
  where
    foCount = countNOTables sodn soa h (init tbls)
countSubfieldsTables sodn soa ((Right (Right (InlinefragmentObject ifo sfs))):t) tbls acc
 | (isServerObjectTable (last tbls) ifo sodn soa)==True = countSubfieldsTables sodn soa (sfs++t) tbls acc
countSubfieldsTables sodn soa (_:t) tbls acc = countSubfieldsTables sodn soa t tbls acc
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])