module Components.ObjectHandlers.ObjectsHandler where import Control.Exception (throw) import Data.Foldable (foldl',foldr') import Model.ServerExceptions ( QueryException( InvalidObjectException, RelationshipConfigurationException, NullArgumentException, InvalidArgumentException, InvalidScalarException ) ) import Model.ServerObjectTypes ( NestedObject(..), ServerObject, ScalarType(..), Alias, SubSelection, SubFields, Field, InlinefragmentObject(..), Argument, Transformation ) -- SCALAR FIELDS -- getScalarArgument :: ScalarType -> String -- getScalarArgument (ScalarType _ _ _ Nothing) = throw NullArgumentException -- getScalarArgument (ScalarType _ _ _ (Just arg)) = arg 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 _ = throw NullArgumentException getSubSelectionArgument :: NestedObject -> String getSubSelectionArgument (NestedObject _ _ _ (Just (ScalarType _ _ _ (Just arg))) _) = arg getSubSelectionArgument _ = throw NullArgumentException 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 foldr' (\x y -> (elem h x)&&y) True 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 InvalidObjectException 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 $ foldr (\cld y->(readFieldObject str ptvs [] cld):y) [] pCldn else readFieldObject str ptvs rst hld readFieldObject _ [] [] _ = throw InvalidObjectException findSingularObject :: [String] -> String findSingularObject (fst:rst) = if all ((==) fst) rst then fst else throw InvalidObjectException findSingularObject [] = throw InvalidObjectException -- 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 = foldr' (\(_,x) y->x==tbl||y) False $ 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 _ [] = throw InvalidObjectException countTableIds :: String -> [(String,[String],String)] -> Int countTableIds tbl ((_,ids,ntbl):t) = if (tbl==ntbl) then length ids else countTableIds tbl t countTableIds _ [] = throw InvalidObjectException {- 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 = foldr' (\(n,_,_)y->(name==n)||y) False fds | otherwise = isValidServerObjectScalarField sobj name t [] isValidServerObjectScalarField sobj name pvs ((pnt,_,cdn):t) = if sobj==pnt then foldr' (\x y->(isValidServerObjectScalarField x name pvs [])&&y) True cdn else isValidServerObjectScalarField sobj name pvs t isValidServerObjectScalarField _ _ [] _ = throw InvalidObjectException 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) [] | sobj==ptv = findAndCheckScalarTransformation name trans arg fds | otherwise = isValidScalarTransformation sobj name (Just trans) arg t [] isValidScalarTransformation sobj name trans arg pvs ((pnt,_,cdn):t) = if sobj==pnt then foldr' (\x y->(isValidScalarTransformation x name trans arg pvs [])&&y) True cdn else isValidScalarTransformation sobj name trans arg pvs t isValidScalarTransformation _ _ _ _ [] _ = throw InvalidObjectException 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 InvalidScalarException findAndCheckTransformationOption :: String -> Argument -> [(String,[(String,String,String,String)])] -> Bool findAndCheckTransformationOption _ Nothing _ = True findAndCheckTransformationOption trans (Just arg) ((name,opts):t) = if trans==name then foldr' (\(n,_,_,_) y->(arg==n)||y) False opts else findAndCheckTransformationOption trans (Just arg) t findAndCheckTransformationOption _ _ [] = throw InvalidArgumentException -- 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 foldl' (\y x->(isValidServerObjectNestedObjectField x name pvo [])&&y) True cdn else isValidServerObjectNestedObjectField sobj name pvo t -- isValidServerObjectNestedObjectField _ _ [] _ = throw InvalidObjectException -- isValidServerObjectNestedObjectField sobj name ((a,b):t) _ -- | sobj==a = elem name b -- | 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])] -> [([String],String)] translateServerObjectToDBName sobj ((a,b,c):t) [] | sobj==a = [(b,c)] | otherwise = translateServerObjectToDBName sobj t [] translateServerObjectToDBName sobj pdn ((so,_,cdn):t) = if sobj==so then foldl' (\y x-> (translateServerObjectToDBName x pdn [])++y) [] cdn else translateServerObjectToDBName sobj pdn t translateServerObjectToDBName _ [] _ = throw InvalidObjectException getDBObjectRelationships :: String -> String -> [(String,String,[String])] -> [String] getDBObjectRelationships from to ((a,b,c):t) | from==a&&to==b = c | otherwise = getDBObjectRelationships from to t getDBObjectRelationships _ _ [] = throw RelationshipConfigurationException