module Components.DataProcessors.PersistentDataProcessor (processReturnedValues) where import Data.Maybe import Data.Either import Data.Text (Text,unpack) import Text.JSON import qualified Control.Exception as E import Model.ServerExceptions import Model.ServerObjectTypes import Components.ObjectHandlers.ObjectsHandler (getSubFields) -- with root objects we want one json representation of separate graphql results... processReturnedValues :: [(String,[(String,String)])] -> [RootObject] -> [[[[Text]]]] -> String processReturnedValues sss robjs rlts = encodeStrict $ processReturnedValuesToJsonObject sss robjs rlts processReturnedValuesToJsonObject :: [(String,[(String,String)])] -> [RootObject] -> [[[[Text]]]] -> JSObject (JSObject JSValue) processReturnedValuesToJsonObject sss robjs rlts = toJSObject [("data", toJSObject [processReturnedValue sss x y | (x,y) <- zip robjs rlts])] -- with qraphql query object and sql return data, we want json representation on graphql query results... processReturnedValue :: [(String,[(String,String)])] -> RootObject -> [[[Text]]] -> (String, JSValue) processReturnedValue sss (NestedObject alias name sobj _ sfs) rlts = (if (alias==Nothing) then name else (fromJust alias), showJSONs $ processSubFields sss sobj sfs rlts) -- with SubFields and data rows, we want json representation on qraphql query data processSubFields :: [(String,[(String,String)])] -> String -> [Field] -> [[[Text]]] -> [JSValue] processSubFields _ _ _ [] = [] processSubFields _ _ [] _ = [] processSubFields sss sobj sfs rlts = if length(dta)>0 then ((showJSON $ toJSObject $ composeGraphQlRow sss sobj sfs $ fetchGraphQlRow dta):(processSubFields sss sobj sfs [removeDataRow dta])) else [] where dta = foldr (\x y -> x++y) [] rlts composeGraphQlRow :: [(String,[(String,String)])] -> String -> [Field] -> [[Text]] -> [(String,JSValue)] composeGraphQlRow _ _ [] ([]:t) = [] -- done -- composeGraphQlRow _ _ _ [] = [] -- no data composeGraphQlRow _ _ _ ([]:t) = E.throw EOFDataProcessingException composeGraphQlRow _ _ [] _ = E.throw EOFDataProcessingException composeGraphQlRow sss sobj (a:b) ((h:t):j) | (isLeft a)==True = ((getScalarFieldLabel scalarField, castJSType (getScalarFields sobj sss) (getScalarFieldName scalarField) h):(composeGraphQlRow sss sobj b (removeNDataColumns 1 ((h:t):j)))) | otherwise = (((getNestedObjectFieldLabel $ fromRight (E.throw InvalidObjectException) a), showJSONs (processSubFields sss sobj (getSubFields $ fromRight (E.throw InvalidObjectException) a) [pullNDataColumns nestedObjectFieldCount ((h:t):j)])):(composeGraphQlRow sss sobj b (removeNDataColumns nestedObjectFieldCount ((h:t):j)))) where nestedObjectFieldCount = (countNestedObjectQueriedFields $ fromRight (E.throw InvalidObjectException) a) scalarField = (fromLeft (E.throw InvalidScalarException) a) 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))] getScalarFieldLabel :: ScalarType -> String getScalarFieldLabel (ScalarType alias name trans arg) = if (alias/=Nothing) then (fromJust alias) else name getScalarFieldName :: ScalarType -> String getScalarFieldName (ScalarType alias name trans arg) = name getNestedObjectFieldLabel :: NestedObject -> String getNestedObjectFieldLabel (NestedObject alias name sobj ss sfs) = if (alias/=Nothing) then (fromJust alias) else name pullNDataColumns :: Int -> [[Text]] -> [[Text]] pullNDataColumns _ [] = [] pullNDataColumns cnt rslt | (cnt<0) = E.throw InvalidArgumentException | otherwise = [if (length x) Int countNestedObjectQueriedFields (NestedObject alias name sobj ss sfs) = 1+(countNestedObjectQueriedSubFields sfs) countNestedObjectQueriedSubFields :: [Field] -> Int countNestedObjectQueriedSubFields [] = 0 countNestedObjectQueriedSubFields (h:t) | (isLeft h)==True = 1+(countNestedObjectQueriedSubFields t) | otherwise = (countNestedObjectQueriedFields (fromRight (E.throw InvalidObjectException) h))+(countNestedObjectQueriedSubFields t) -- remove nested object columns from data row that is including nested object id removeNDataColumns :: Int -> [[Text]] -> [[Text]] removeNDataColumns 0 rslt = rslt removeNDataColumns (-1) _ = E.throw EOFDataProcessingException removeNDataColumns _ [[]] = [[]] removeNDataColumns _ ([]:t) = E.throw EOFDataProcessingException removeNDataColumns cnt rslt = removeNDataColumns (cnt-1) [t | (h:t)<-rslt] getScalarFields :: String -> [(String,[(String,String)])] -> [(String,String)] getScalarFields sobj [] = E.throw InvalidObjectException getScalarFields sobj ((nam,oflds):t) = if (sobj==nam) then oflds else (getScalarFields sobj t) castJSType :: [(String,String)] -> String -> Text -> JSValue castJSType [] fld val = E.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) = E.throw InvalidVariableTypeException | otherwise = castJSType t fld val