module Components.ObjectHandlers.ObjectsHandler where import Model.ServerExceptions ( QueryException( InvalidObjectException, RelationshipConfigurationException, NullArgumentException ) ) import Model.ServerObjectTypes ( NestedObject(..), ServerObject, ScalarType(..), Alias, SubSelection, SubFields, Field, InlinefragmentObject(..), Argument, Transformation ) import Data.Maybe (fromJust,Maybe(Nothing)) import Control.Exception (throw) {- parsing frontend query to server query - A valid argument is any string that is provided to reference database objects -} readServerObject :: String -> [(String,[String])] -> [(String,[String],[String])] -> ServerObject readServerObject str [] [] = throw InvalidObjectException readServerObject str ((a,b):t) c = if (elem str b)==True then (a :: ServerObject) else readServerObject str t c readServerObject str [] ((a,b,_):t) = if (elem str b)==True then (a :: ServerObject) else readServerObject str [] t {- checking server type attributes -} -- EFFECT: returns exclusive list of valid fields that are found in the database table for each Server object -- this is used to check queries against valid subfields isValidServerObjectScalarField :: ServerObject -> String -> [(String,[(String,String)])] -> [(String,[String],[String])] -> Bool isValidServerObjectScalarField _ _ [] _ = throw InvalidObjectException isValidServerObjectScalarField sobj name pvs ((pnt,_,cdn):t) = if sobj==pnt then (foldr (\x y->(isValidServerObjectScalarField x name pvs [])&&y) True cdn)||(isValidServerObjectScalarField sobj name pvs t) else isValidServerObjectScalarField sobj name pvs t isValidServerObjectScalarField sobj name ((ptv,fds):t) _ | sobj==ptv&&(elem name $ getScalarNames fds)==True = True -- | sobj==a = False | otherwise = isValidServerObjectScalarField sobj name t [] getScalarNames :: [(String,String)] -> [String] getScalarNames lst = [a | (a,b) <- lst] -- you can create as many relationships as you want with your server... isValidServerObjectNestedObjectField :: ServerObject -> String -> [(String,[String])] -> [(String,[String],[String])] -> Bool isValidServerObjectNestedObjectField sobj name pvo ((so,_,cdn):t) = if sobj==so then (elem name $ getParentObjects cdn pvo)||(isValidServerObjectNestedObjectField sobj name pvo t) else isValidServerObjectNestedObjectField sobj name pvo t isValidServerObjectNestedObjectField _ _ [] _ = throw InvalidObjectException isValidServerObjectNestedObjectField sobj name ((a,b):t) _ | sobj==a&&(elem name b)==True = True -- | sobj==a = False | otherwise = isValidServerObjectNestedObjectField sobj name t [] -- split server object to sql query -- EFFECTS: returns the database table references for the server object. translateServerObjectToDBName :: ServerObject -> [(String,String)] -> [(String,[String],[String])] -> [String] translateServerObjectToDBName sobj pdn ((so,_,cdn):t) = if sobj==so then (foldr (\x y -> (translateServerObjectToDBName x pdn [])++y) [] cdn)++(translateServerObjectToDBName sobj pdn t) else translateServerObjectToDBName sobj pdn t translateServerObjectToDBName _ [] _ = [] -- throw InvalidObjectException translateServerObjectToDBName sobj ((a,b):t) _ | sobj==a = [b] | otherwise = translateServerObjectToDBName sobj t [] -- TODO: list all server objects and their associated entities -- EFFECT: with serverobject and serverobject attribute, we want the identity table, identity field, reference table, reference field, and triple elements if present of identity-to-reference-tables-order intermediate table, to-intermediate field, and from-itermediate field -- You can define direct relationships (around only one link) or indirect (but you'll code the database query by yourself...) getDBObjectRelationships :: String -> String -> [(String,String,[String])] -> [String] getDBObjectRelationships _ _ [] = throw RelationshipConfigurationException getDBObjectRelationships from to ((a,b,c):t) | from==a&&to==b = c | otherwise = getDBObjectRelationships from to t -- SCALAR FIELDS getScalarName :: ScalarType -> String getScalarName (ScalarType alias name trans arg) = name getScalarArgument :: ScalarType -> String getScalarArgument (ScalarType alias name trans arg) = if arg==Nothing then (throw NullArgumentException) else (fromJust arg) getTransformation :: ScalarType -> (Transformation,Argument) getTransformation (ScalarType alias name trans arg) = (trans,arg) getScalarFieldLabel :: ScalarType -> String getScalarFieldLabel (ScalarType alias name trans arg) = if (alias/=Nothing) then (fromJust alias) else name -- NESTED OBJECTS getObjectName :: NestedObject -> String getObjectName (NestedObject alias name sobj ss sf) = name getObjectAlias :: NestedObject -> Alias getObjectAlias (NestedObject alias name sobj ss sf) = alias getServerObject :: NestedObject -> ServerObject getServerObject (NestedObject alias name sobj ss sf) = sobj getObjectSubSelection :: NestedObject -> SubSelection getObjectSubSelection (NestedObject alias name sobj ss sf) = ss withSubSelection :: NestedObject -> Bool withSubSelection (NestedObject alias name sobj ss sf) = (ss/=Nothing) getSubSelectionField :: NestedObject -> String getSubSelectionField (NestedObject alias name sobj ss sf) = getScalarName $ fromJust ss getSubSelectionArgument :: NestedObject -> String getSubSelectionArgument (NestedObject alias name sobj ss sf) = getScalarArgument $ fromJust ss getSubFields :: NestedObject -> SubFields getSubFields (NestedObject alias name sobj ss sf) = sf isSameNObjectReference :: NestedObject -> NestedObject -> Bool isSameNObjectReference (NestedObject alias1 name1 sobj1 ss1 sfs1) (NestedObject alias2 name2 sobj2 ss2 sfs2) = alias1==alias2&&name1==name2&&sobj1==sobj2 isSameObjectSubSelection :: NestedObject -> NestedObject -> Bool isSameObjectSubSelection (NestedObject alias1 name1 sobj1 ss1 sfs1) (NestedObject alias2 name2 sobj2 ss2 sfs2) = ss1==ss2 getNestedObjectFieldLabel :: NestedObject -> String getNestedObjectFieldLabel (NestedObject alias name sobj ss sfs) = if (alias/=Nothing) then (fromJust alias) else name -- INLINE-FRAGMENTS isSameIFObjectReference :: InlinefragmentObject -> InlinefragmentObject -> Bool isSameIFObjectReference (InlinefragmentObject obj1 sf1) (InlinefragmentObject obj2 sf2) = obj1==obj2 getInlinefragmentObject :: InlinefragmentObject -> ServerObject getInlinefragmentObject (InlinefragmentObject obj sf) = obj getInlinefragmentFields :: InlinefragmentObject -> [Field] getInlinefragmentFields (InlinefragmentObject obj sf) = sf -- SERVER OBJECTS isValidServerObjectChild :: ServerObject -> ServerObject -> [(String,[String],[String])] -> Bool isValidServerObjectChild _ _ [] = False isValidServerObjectChild pnt cld ((so,_,cdn):t) = if pnt==so then (elem cld cdn)||(isValidServerObjectChild pnt cld t) else isValidServerObjectChild pnt cld t getServerObjectScalars :: ServerObject -> [(String,[(String,String)])] -> [(String,[String],[String])] -> [(String,String)] getServerObjectScalars _ [] _ = throw InvalidObjectException getServerObjectScalars sobj sss ((pnt,_,cdn):t) = if (sobj==pnt) then getIntersection [getServerObjectScalars x sss [] | x<-cdn] else getServerObjectScalars sobj sss t getServerObjectScalars sobj ((cld,fds):t) _ = if (sobj==cld) then fds else getServerObjectScalars sobj t [] -- BASIC getIntersection :: Eq a => [[a]] -> [a] getIntersection [] = [] getIntersection ([]:t) = [] getIntersection ((h:t1):t2) = if (foldr (\x y -> (elem h x)&&y) True t2) then (h:(getIntersection (t1:t2))) else (getIntersection (t1:t2)) getParentObjects :: [String] -> [(String,[String])] -> [String] getParentObjects cdn sos = getIntersection $ getChildrenObjects cdn sos getChildrenObjects :: [String] -> [(String,[String])] -> [[String]] getChildrenObjects [] _ = [] getChildrenObjects (h:t) sos = (getChildObjects h sos):(getChildrenObjects t sos) getChildObjects :: String -> [(String,[String])] -> [String] getChildObjects _ [] = [] getChildObjects cld ((so,obs):t) = if cld==so then obs++(getChildObjects cld t) else getChildObjects cld t isServerObjectTable :: String -> ServerObject -> [(String,String)] -> [(String,[String],[String])] -> Bool isServerObjectTable tbl soj sodn soa = elem tbl $ translateServerObjectToDBName soj sodn soa