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 ) -- root objects to one json representation of separate graphql results processReturnedValues :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> [RootObject] -> [[[(Int,Bool,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] -> [[[(Int,Bool,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])] -- qraphql query object and sql return data to json representation on graphql query results processReturnedValue :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> RootObject -> [[(Int,Bool,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) -- SubFields and data rows to json representation on qraphql query data processSubFields :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[Text]]]] -> [JSValue] processSubFields sss sodn soa sobj tbls (sf:sfs) (vRlt:rlts) | all (\x -> (null x)||(null $ head x)) (vRlt:rlts) = [] -- all first query (object query) are no results (or no query) | oneObject&&(null object)==False = (showJSON $ toJSObject object):(processSubFields sss sodn soa sobj tbls (sf:sfs) remData) | oneObject = processSubFields sss sodn soa sobj tbls (sf:sfs) remData | otherwise = [showJSON $ toJSObject x | x<-objects, (null x)==False]++(processSubFields sss sodn soa sobj tbls (sf:sfs) remData) where oneObject = all (\x -> (null x)||((snd3 $ head x)==False)) $ tail tbls zDta = zip3 tbls (vRlt:rlts) idCounts object = makeOneGQLObject sss sodn soa sobj tbls (sf:sfs) [fetchGraphQlRow dt idC | (_,dt,idC)<-zDta] notEmptyQueryResults = [(x,y,z) | (x,y,z)<-zDta,(null x)==False,(null y)==False,(null $ head y)==False] -- groupedData :: [[([(Int,Bool,String)],[[[Text]]])]] groupedData = foldl' (\z (x,y) ->if (null z)==True then [[(x,y)]] else if (null x)||((snd3 $ head x)==False) then ((init z)++[(last z)++[(x,y)]]) else (z++[[(x,y)]])) [] $ [(x,fetchGraphQlRow y z) | (x,y,z)<-notEmptyQueryResults] -- labeledData :; [([[(Int,Bool,String)]],[[[[Text]]]])] labeledData = [unzip x | x<-groupedData] objects = foldr (\(x,y) z -> (makeOneGQLObject sss sodn soa sobj x (sf:sfs) y):z) [] labeledData remData = [removeDataRow x idC | (_, x, idC)<-zDta] idCounts = if (null tbls)||(null $ head tbls) then [] else foldl' (\y x -> if (null x) then y++[0] else if (not $ snd3 $ head x) then y++[last y] else y++[countTableIds (thd3 $ head x) sodn]) [countTableIds (thd3 $ head $ head tbls) sodn] $ tail tbls processSubFields _ _ _ _ _ _ [] = [] -- no variants (maybe not possible) processSubFields _ _ _ _ _ [] _ = [] -- no fields (when finished) thd3 :: (a,b,c) -> c thd3 (_,_,x) = x snd3 :: (a,b,c) -> b snd3 (_,x,_) = x makeOneGQLObject :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],String)] -> [(String,[String],[String])] -> String -> [[(Int,Bool,String)]] -> [Field] -> [[[[Text]]]] -> [(String,JSValue)] makeOneGQLObject _ _ _ _ [] _ _ = throw EOFDataProcessingException -- no reference tables (unusual) makeOneGQLObject _ _ _ _ ([]:_) _ _ = throw EOFDataProcessingException -- no reference tables in first varient (unusual) makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias "__typename" trans arg)):b) dat = (getScalarFieldLabel $ ScalarType alias "__typename" trans arg, showJSON $ pack $ translateTableToObject (thd3 $ head $ head tbls) sodn):(makeOneGQLObject sss sodn soa sobj tbls b dat) makeOneGQLObject sss sodn soa sobj tbls ((Left (ScalarType alias name trans arg)):b) ((((i:j):k):l):m) = (getScalarFieldLabel $ ScalarType alias name trans arg, castJSType (findPrimitiveScalarTypeType (translateTableToObject (thd3 $ head $ head tbls) sodn) name trans arg sss) i):(makeOneGQLObject sss sodn soa sobj tbls b (((j:k):l):m)) makeOneGQLObject sss sodn soa sobj tbls ((Right (Left (NestedObject alias name nso ss sfs))):b) ((j:k):l) = ((getNestedObjectFieldLabel $ NestedObject alias name nso ss sfs), showJSONs (processSubFields sss sodn soa nso nxtTbls sfs nxtData)):(makeOneGQLObject sss sodn soa sobj remTbls b remData) where (nxtTbls,nxtData,remTbls,remData) = separateObjectData tbls ((j:k):l) makeOneGQLObject sss sodn soa sobj tbls ((Right (Right (InlinefragmentObject ifo sfs))):b) dat | (isServerObjectTable (thd3 $ head $ head tbls) ifo sodn soa)==True = makeOneGQLObject sss sodn soa sobj tbls (sfs++b) dat | otherwise = makeOneGQLObject sss sodn soa sobj tbls b dat makeOneGQLObject _ _ _ _ _ [] ((([]:_):_):_) = [] -- no columns (in first variant and first query) and no fields (done) makeOneGQLObject _ _ _ _ _ _ (([]:_):_) = [] -- no rows (no data) makeOneGQLObject _ _ _ _ _ ((Right (Left _)):[]) ([]:_) = throw EOFDataProcessingException -- field and no queries (unusual) makeOneGQLObject _ _ _ _ _ _ ([]:_) = [] -- no queries (no data) makeOneGQLObject _ _ _ _ _ _ [] = [] -- no variants (unusual) makeOneGQLObject _ _ _ _ _ [] _ = [] -- columns and no fields (done or error) makeOneGQLObject _ _ _ _ _ ((Left _):_) ((([]:_):_):_) = throw EOFDataProcessingException -- field and no result columns separateObjectData :: [[(Int,Bool,String)]] -> [[[[Text]]]] -> ([[(Int,Bool,String)]],[[[[Text]]]],[[(Int,Bool,String)]],[[[[Text]]]]) separateObjectData info dat = foldl' (\(nTbls,nDt,rTbls,rDt) (meta,ndt)-> let mty = null meta one = (length meta)==1 newMeta = if mty||one then [] else (lvl,fst,tbl):(take (objQryCount-1) flwObjs) newData = if mty then [] else if fFst then take (length newMeta) nxtDat else if tblPos<=((length newMeta)-1) then take ((length nxtObjs)-tblPos) ndt else [] remMeta = if mty then [] else if one then meta else (head meta):(drop objQryCount $ nxtObjs) remData = if mty then [] else if fFst then (head ndt):(drop objQryCount nxtDat) else if tblPos<=(objQryCount-1) then [] else ndt nxtObjs = tail meta flwObjs = tail nxtObjs nxtDat = tail ndt (lvl,fst,tbl) = head nxtObjs objQryCount = foldr' (\(nlvl,nfst,ntbl) y->if nlvl<=lvl then 1 else y+1) 1 flwObjs tblPos = foldr' (\(idx,(_,fst,_)) y->if fst then idx else y) ((length nxtObjs)-1) $ zip [0..] $ nxtObjs (_,fFst,_) = head meta in (nTbls++[newMeta],nDt++[newData],rTbls++[remMeta],rDt++[remData])) ([],[],[],[]) $ zip info dat findPrimitiveScalarTypeType :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> String findPrimitiveScalarTypeType sobj name trans arg ((obj,flds):rst) | sobj==obj = findScalarTypeType name trans arg flds | otherwise = findPrimitiveScalarTypeType sobj name trans arg rst findPrimitiveScalarTypeType _ _ _ _ [] = throw InvalidObjectException findScalarTypeType :: String -> Transformation -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> String 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 findScalarTypeType _ _ _ [] = throw InvalidScalarException findArgumentOptionType :: String -> Argument -> [(String,[(String,String,String,String)])] -> String 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 findArgumentOptionType _ _ [] = throw InvalidArgumentException findOptionType :: String -> [(String,String,String,String)] -> String findOptionType arg ((oname,typ,_,_):rst) | arg==oname = typ | otherwise = findOptionType arg rst findOptionType _ [] = throw InvalidArgumentException fetchGraphQlRow :: [[[Text]]] -> Int -> [[[Text]]] fetchGraphQlRow _ 0 = [] -- no queries fetchGraphQlRow [] _ = [] -- no queries fetchGraphQlRow ([]:_) _ = [] -- no query results for object fetchGraphQlRow rlts idCols = if (all ((==) nll) firstIds) then [] else [[drop idCols rw | rw<-qryRlt, (take idCols rw)==firstIds] | qryRlt<-rlts] where firstIds = take idCols $ head $ head rlts nll = pack "Unexpected null" removeDataRow :: [[[Text]]] -> Int -> [[[Text]]] removeDataRow _ 0 = [] -- no queries removeDataRow ([]:_) _ = [] -- no query results for object removeDataRow rlts idCols = [[rw | rw<-qryRlt, (take idCols rw)/=firstIds] | qryRlt<-rlts] where firstIds = take idCols $ head $ 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 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 -- countQueriedSubFieldsHelper _ _ [] _ acc = 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 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 -- countSubfieldsTables _ _ [] _ acc = 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])