module Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables) where
import Model.ServerObjectTypes (
ServerObject,
RootObject,
ScalarType(..),
SubSelection,
Field,
FieldObject,
InlinefragmentObject(..),
NestedObject(..)
)
import Model.ServerExceptions (
QueryException(
InvalidObjectException,
InvalidVariableNameException,
InvalidObjectScalarFieldException,
MismatchedVariableTypeException
)
)
import Components.ObjectHandlers.ObjectsHandler (
getObjectName,
getInlinefragmentFields,
getInlinefragmentObject,
isValidServerObjectChild,
isValidServerObjectNestedObjectField,
getScalarName,
isValidServerObjectScalarField
)
import Control.Exception (throw)
import Data.Maybe (fromJust,Maybe(Just,Nothing))
import Data.Either (Either(Right,Left))
checkObjectsAttributes :: [RootObject] -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool
checkObjectsAttributes objs sss sos soa = foldr (\x y -> (hasValidAttributes x sss sos soa)&&y) True objs
hasValidAttributes :: NestedObject -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool
hasValidAttributes (NestedObject alias name sobject ss sfs) sss sos soa = (if ss==Nothing then True else isValidSubSelection sobject (fromJust ss) sss soa)&&(isValidSubFields sobject sfs sss sos soa)
isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String)])] -> [(String,[String],[String])] -> Bool
isValidSubSelection obj (ScalarType alias name trans arg) sss soa = (isValidServerObjectScalarField obj name sss soa)
isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool
isValidSubFields _ [] _ _ _ = True
isValidSubFields obj sfs sss sos soa = foldr (\x y -> (isValidSubField obj x sss sos soa)&&y) True sfs
isValidSubField :: ServerObject -> Field -> [(String,[(String,String)])]-> [(String,[String])] -> [(String,[String],[String])] -> Bool
isValidSubField obj (Left sf) sss sos soa = ((getScalarName sf)=="__typename")||(isValidServerObjectScalarField obj (getScalarName sf) sss soa)
isValidSubField obj (Right (Left no)) sss sos soa = (isValidServerObjectNestedObjectField obj (getObjectName no) sos soa)&&(hasValidAttributes no sss sos soa)
isValidSubField obj (Right (Right ifo)) sss sos soa = (isValidServerObjectChild obj soj soa)&&(isValidSubFields soj (getInlinefragmentFields ifo) sss sos soa)
where soj = getInlinefragmentObject ifo
replaceObjectsVariables :: [(String,[(String,String)])] -> [RootObject] -> [(String,String,String)] -> [RootObject]
replaceObjectsVariables _ [] _ = []
replaceObjectsVariables sss objs vars = [replaceObjectVariables sss obj vars | obj<-objs]
replaceObjectVariables :: [(String,[(String,String)])] -> RootObject -> [(String,String,String)] -> RootObject
replaceObjectVariables sss (NestedObject alias name sobject ss sfs) vars = NestedObject alias name sobject (if ss/=Nothing then (replaceScalarVariable (findScalars sss sobject) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss sobject vars sf | sf<-sfs]
findScalars :: [(String,[(String,String)])] -> String -> [(String,String)]
findScalars [] _ = throw InvalidObjectException
findScalars ((name,sclrs):t) sobj = if (sobj==name) then sclrs else (findScalars t sobj)
replaceScalarVariable :: [(String,String)] -> [(String,String,String)] -> ScalarType -> SubSelection
replaceScalarVariable sclrs vars (ScalarType alias name trans arg) = if (isValue arg)&&(elem '$' $ getValue arg) then (Just $ ScalarType alias name trans (Just $ findReplacement (findScalarType sclrs name) (getValue arg) vars)) else (Just $ ScalarType alias name trans arg)
findScalarType :: [(String,String)] -> String -> String
findScalarType [] _ = throw InvalidObjectScalarFieldException
findScalarType ((name,typ):t) sname = if sname==name then typ else (findScalarType t sname)
findReplacement :: String -> String -> [(String,String,String)] -> String
findReplacement styp arg [] = throw InvalidVariableNameException
findReplacement styp arg ((name,typ,val):t)
| (name==arg)&&(typ==styp) = val
| (name==arg) = throw MismatchedVariableTypeException
| otherwise = findReplacement styp arg t
replaceSubfieldVariables :: [(String,[(String,String)])] -> String -> [(String,String,String)] -> Field -> Field
replaceSubfieldVariables sss sobj vars (Left (ScalarType alias name trans arg)) = if (isValue arg)&&(elem '$' $ getValue arg) then (Left (ScalarType alias name trans (Just $ findReplacement (findScalarType (findScalars sss sobj) name) (getValue arg) vars)) :: Field) else (Left (ScalarType alias name trans arg) :: Field)
replaceSubfieldVariables sss sobj vars (Right (Left (NestedObject alias name nsobj ss sfs))) = (Right (Left $ NestedObject alias name nsobj (if ss/=Nothing then (replaceScalarVariable (findScalars sss nsobj) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss nsobj vars sf | sf<-sfs] :: FieldObject) :: Field)
replaceSubfieldVariables sss sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = (Right (Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss ifsobj vars sf | sf<-sfs] :: FieldObject) :: Field)
isValue :: Maybe String -> Bool
isValue Nothing = False
isValue _ = True
getValue :: Maybe String -> String
getValue arg = fromJust arg