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 ) import Data.Maybe (Maybe(Nothing),fromJust) import Data.Either (fromRight,fromLeft,isLeft) import Data.Text (Text,unpack) 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 = [] | (foldr (\x y->(last x)==(last $ head tbls)&&y) True tbls) = ((showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls sfs [removeDataRow x | x<-rlts])) | otherwise = ([showJSON $ toJSObject x | x<-objects]++(processSubFields sss sodn soa sobj tbls sfs [removeDataRow x | x<-rlts])) where 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:[]) (([]:_):_) = if (isLeft f)==True||(isLeft fo)==True||(isServerObjectTable (last $ head tbls) (getInlinefragmentObject ifo) sodn soa)==False then [] else throw EOFDataProcessingException -- fields and no result columns where 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 = ((getScalarFieldLabel scalarField, castJSType (getServerObjectScalars sobj sss soa) (getScalarName scalarField) 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 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 = [init x | x<-tbls] nestedObjectFieldCounts = [countNOQueriedFields sodn soa no x | x<-nxtTbls] scalarField = (fromLeft (throw InvalidScalarException) a) fo = fromRight (throw InvalidObjectException) a no = fromLeft (throw InvalidObjectException) fo ifo = fromRight (throw InvalidObjectException) fo fetchGraphQlRow :: [[Text]] -> [[Text]] fetchGraphQlRow rlts = [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 = [if (length x) [(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 = 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 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