module Components.ObjectHandlers.ObjectsHandler where import Control.Exception (throw) import Model.ServerExceptions ( ReferenceException( UnrecognisedObjectException, DisagreeingObjectFieldsException, UnrecognisedScalarException, UnrecognisedArgumentException, UnrecognisedRelationshipException ) ) import Model.ServerObjectTypes ( NestedObject(..), ServerObject, ScalarType(..), Alias, SubSelection, SubFields, Field, InlinefragmentObject(..), Argument, Transformation ) import Components.Util (fst3,fst4) -- SCALAR FIELDS getScalarFieldLabel :: ScalarType -> String getScalarFieldLabel (ScalarType Nothing name _ _) = name getScalarFieldLabel (ScalarType (Just alias) _ _ _) = alias -- NESTED OBJECTS getServerObject :: NestedObject -> ServerObject getServerObject (NestedObject _ _ sobj _ _) = sobj withSubSelection :: NestedObject -> Bool withSubSelection (NestedObject _ _ _ ss _) = (ss/=Nothing) getSubSelectionField :: NestedObject -> String getSubSelectionField (NestedObject _ _ _ (Just (ScalarType _ name _ _)) _) = name getSubSelectionField _ = error "Subselection request value is not found (source error)." getSubSelectionArgument :: NestedObject -> String getSubSelectionArgument (NestedObject _ _ _ (Just (ScalarType _ _ _ (Just arg))) _) = arg getSubSelectionArgument _ = error "Subselection request value is not found (source error)." getSubFields :: NestedObject -> SubFields getSubFields (NestedObject _ _ _ _ sf) = sf isSameNObjectReference :: NestedObject -> NestedObject -> Bool isSameNObjectReference (NestedObject alias1 name1 sobj1 _ _) (NestedObject alias2 name2 sobj2 _ _) = alias1==alias2&&name1==name2&&sobj1==sobj2 isSameObjectSubSelection :: NestedObject -> NestedObject -> Bool isSameObjectSubSelection (NestedObject _ _ _ ss1 _) (NestedObject _ _ _ ss2 _) = ss1==ss2 getNestedObjectFieldLabel :: NestedObject -> String getNestedObjectFieldLabel (NestedObject Nothing name _ _ _) = name getNestedObjectFieldLabel (NestedObject (Just alias) _ _ _ _) = alias -- BASIC getIntersection :: Eq a => [[a]] -> [a] getIntersection [] = [] getIntersection ([]:t) = [] getIntersection ((h:t1):t2) = if all (elem h) t2 then h:getIntersection (t1:t2) else getIntersection (t1:t2) -- REFERENCE SCHEMA {- 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 ptv ((a,b,_):t) = if (elem str b)==True then (a :: ServerObject) else readServerObject str ptv t readServerObject str ((a,b):t) [] = if (elem str b)==True then (a :: ServerObject) else readServerObject str t [] readServerObject _ [] [] = throw UnrecognisedObjectException readFieldObject :: String -> [(String,[(String,[String])])] -> [(String,[String],[String])] -> ServerObject -> ServerObject readFieldObject str ((ptv,objs):rst) [] hld = if hld==ptv then readServerObject str objs [] else readFieldObject str rst [] hld readFieldObject str ptvs ((pObj,_,pCldn):rst) hld = if hld==pObj then findSingularObject $ map (\cld->readFieldObject str ptvs [] cld) pCldn else readFieldObject str ptvs rst hld readFieldObject _ [] [] _ = throw UnrecognisedObjectException findSingularObject :: [String] -> String findSingularObject (fst:rst) = if all ((==) fst) rst then fst else throw DisagreeingObjectFieldsException findSingularObject [] = throw UnrecognisedObjectException -- INLINE-FRAGMENTS isSameIFObjectReference :: InlinefragmentObject -> InlinefragmentObject -> Bool isSameIFObjectReference (InlinefragmentObject obj1 _) (InlinefragmentObject obj2 _) = obj1==obj2 -- SERVER OBJECTS isValidServerObjectChild :: ServerObject -> ServerObject -> [(String,[String],[String])] -> Bool isValidServerObjectChild pnt cld ((so,_,cdn):t) = if pnt==so then elem cld cdn else isValidServerObjectChild pnt cld t isValidServerObjectChild _ _ [] = False -- SCHEMA HEIRARCHY isServerObjectTable :: String -> ServerObject -> [(String,[String],String)] -> [(String,[String],[String])] -> Bool isServerObjectTable tbl soj sodn soa = any ((==) tbl . snd) $ translateServerObjectToDBName soj sodn soa translateTableToObject :: String -> [(String,[String],String)] -> String translateTableToObject tbl ((pObj,_,pTbl):rst) = if tbl==pTbl then pObj else translateTableToObject tbl rst translateTableToObject _ [] = error "Table not found in schema (source error)." countTableIds :: String -> [(String,[String],String)] -> Int countTableIds tbl ((_,ids,ntbl):t) = if tbl==ntbl then length ids else countTableIds tbl t countTableIds " " _ = 0 countTableIds _ [] = error "Table not found in schema (source error)." fetchTableIds :: String -> [(String,[String],String)] -> [String] fetchTableIds tbl ((_,ids,ntbl):t) = if tbl==ntbl then ids else fetchTableIds tbl t {- checking server type attributes -} -- 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,String,String)])])])] -> [(String,[String],[String])] -> Bool isValidServerObjectScalarField sobj name ((ptv,fds):t) [] | sobj==ptv = any ((==) name . fst3) fds | otherwise = isValidServerObjectScalarField sobj name t [] isValidServerObjectScalarField sobj name pvs ((pnt,_,cdn):t) = if sobj==pnt then all (\x->isValidServerObjectScalarField x name pvs []) cdn else isValidServerObjectScalarField sobj name pvs t isValidServerObjectScalarField _ _ [] _ = throw UnrecognisedObjectException isValidScalarTransformation :: ServerObject -> String -> Transformation -> Argument -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool isValidScalarTransformation _ _ Nothing _ _ _ = True isValidScalarTransformation sobj name (Just trans) arg ((ptv,fds):t) [] = if sobj==ptv then findAndCheckScalarTransformation name trans arg fds else isValidScalarTransformation sobj name (Just trans) arg t [] isValidScalarTransformation sobj name trans arg pvs ((pnt,_,cdn):t) = if sobj==pnt then all (\x->isValidScalarTransformation x name trans arg pvs []) cdn else isValidScalarTransformation sobj name trans arg pvs t isValidScalarTransformation _ _ _ _ [] _ = throw UnrecognisedObjectException findAndCheckScalarTransformation :: String -> String -> Argument -> [(String,String,[(String,[(String,String,String,String)])])] -> Bool findAndCheckScalarTransformation name trans arg ((n,_,args):t) = if name==n then findAndCheckTransformationOption trans arg args else findAndCheckScalarTransformation name trans arg t findAndCheckScalarTransformation name trans arg [] = throw UnrecognisedScalarException findAndCheckTransformationOption :: String -> Argument -> [(String,[(String,String,String,String)])] -> Bool findAndCheckTransformationOption _ Nothing _ = True findAndCheckTransformationOption trans (Just arg) ((name,opts):t) = if trans==name then any ((==) arg . fst4) opts else findAndCheckTransformationOption trans (Just arg) t findAndCheckTransformationOption _ _ [] = throw UnrecognisedArgumentException -- INTERFACES -- split server object to sql query -- EFFECTS: returns the database table references for the server object. translateServerObjectToDBName :: ServerObject -> [(String,[String],String)] -> [(String,[String],[String])] -> [([String],String)] translateServerObjectToDBName sobj ((a,b,c):t) [] = if sobj==a then [(b,c)] else translateServerObjectToDBName sobj t [] translateServerObjectToDBName sobj pdn ((so,_,cdn):t) = if sobj==so then concat $ map (\x->translateServerObjectToDBName x pdn []) cdn else translateServerObjectToDBName sobj pdn t translateServerObjectToDBName _ [] _ = throw UnrecognisedObjectException getDBObjectRelationships :: String -> String -> [(String,String,[String])] -> [String] getDBObjectRelationships from to ((a,b,c):t) = if from==a&&to==b then c else getDBObjectRelationships from to t getDBObjectRelationships _ _ [] = throw UnrecognisedRelationshipException isInterface :: [(String,[String],[String])] -> ServerObject -> Bool isInterface ((so,_,_):t) sobj = if sobj==so then True else isInterface t so isInterface [] _ = False translateInterfaceToServerObjects :: [(String,[String],[String])] -> ServerObject -> [String] translateInterfaceToServerObjects ((so,_,cdn):t) sobj = if sobj==so then cdn else translateInterfaceToServerObjects t sobj translateInterfaceToServerObjects _ _ = throw UnrecognisedObjectException