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.Foldable (foldl',foldr') 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, countTableIds ) -- 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],[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],[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],[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 -> [[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 $ foldl' (++) [] rlts)==True = [] | sameTables&&(null object)==False = (showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls sfs remData) | sameTables = processSubFields sss sodn soa sobj tbls sfs remData | otherwise = [showJSON $ toJSObject x | x<-objects, (null x)==False]++(processSubFields sss sodn soa sobj tbls sfs remData) where sameTables = foldr' (\x y->(last x)==(last $ head tbls)&&y) True tbls object = makeOneGQLObject sss sodn soa sobj tbls sfs [fetchGraphQlRow x idC | (idC, x)<-zip idCounts rlts] -- different tables is possibly different result rows. I should not assume that they are same. notEmptyQueryResults = [(x,y,z) | (x,y,z)<-zip3 tbls rlts idCounts, 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 z) | (x,y,z)<-notEmptyQueryResults] labeledData = [unzip x | x<-groupedData] objects = foldr (\(x,y) z -> (makeOneGQLObject sss sodn soa sobj x sfs y):z) [] labeledData remData = [removeDataRow x idC | (idC, x)<-zip idCounts rlts] idCounts = [countTableIds (last tbl) sodn | tbl<-tbls] -- 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 -> [[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]] -> Int -> [[Text]] fetchGraphQlRow rlts idRows = if (all ((==) (pack "Unexpected null")) firstIds) then [] else [drop idRows rltRow | rltRow<-rlts, (take idRows rltRow)==firstIds] where firstIds = take idRows $ head rlts removeDataRow :: [[Text]] -> Int -> [[Text]] removeDataRow rlts idRows = [rltRow | rltRow<-rlts, (take idRows rltRow)/=(take idRows $ head rlts)] pullNDataColumns :: Int -> [[Text]] -> [[Text]] pullNDataColumns _ [] = [] pullNDataColumns cnt rslt | (cnt<0) = throw InvalidArgumentException | otherwise = [if (length x) [(String,[String],[String])] -> NestedObject -> [String] -> Int countQueriedSubFields sodn soa (NestedObject alias name sobj ss sfs) tbls = countQueriedSubFieldsHelper sodn soa sfs tbls $ countTableIds (last tbls) sodn countQueriedSubFieldsHelper :: [(String,[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 nxtTblSet $ countTableIds (last nxtTblSet) sodn) where nxtTblSet = init tbls 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],[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],[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])