summaryrefslogtreecommitdiff
path: root/src/Components/DataProcessors/PersistentDataProcessor.hs
blob: 14ea96f229a071ccd50d1c3e7fa711c83d6bb2ba (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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)<cnt then (E.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
countNestedObjectQueriedFields :: NestedObject -> 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