module Components.ObjectHandlers.ServerObjectInspector (checkObjectsAttributes,replaceObjectsVariables,flagOneWay) where


import Control.Exception (throw)
import Data.Foldable (foldl')
import Model.ServerObjectTypes (
        ServerObject,
        RootObject,
        ScalarType(..),
        Field,
        InlinefragmentObject(..),
        NestedObject(..),
        FlagNode(..)
    )
import Model.ServerExceptions (
        ReferenceException(
            UnrecognisedObjectException,
            UnrecognisedScalarException
        ),
        QueryException(MismatchedVariableTypeException)
    )
import Components.ObjectHandlers.ObjectsHandler (
        isValidServerObjectChild,
        isValidServerObjectScalarField,
        isValidScalarTransformation,
        isInterface,
        translateInterfaceToServerObjects
    )

-- check that all nested objects are with valid properties
checkObjectsAttributes :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> Bool
checkObjectsAttributes sss soa objs = all (\x->hasValidAttributes x sss soa) objs
hasValidAttributes :: NestedObject -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
hasValidAttributes (NestedObject alias name sobject Nothing sfs) sss soa = isValidSubFields sobject sfs sss soa
hasValidAttributes (NestedObject alias name sobject (Just ss) sfs) sss soa = (isValidSubSelection sobject ss sss soa)&&isValidSubFields sobject sfs sss soa
isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubSelection obj (ScalarType alias name trans arg) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa
isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubFields _ [] _ _ = True  -- we should not get an empty query
isValidSubFields obj sfs sss soa = all (\x->isValidSubField obj x sss soa) sfs
isValidSubField :: ServerObject -> Field -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubField obj (Left (ScalarType alias "__typename" trans arg)) sss soa = True
isValidSubField obj (Left (ScalarType alias name trans arg)) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa
isValidSubField obj (Right (Left (NestedObject alias name sobject ss sfs))) sss soa = hasValidAttributes (NestedObject alias name sobject ss sfs) sss soa
isValidSubField obj (Right (Right (InlinefragmentObject ifo sfs))) sss soa = (isValidServerObjectChild obj ifo soa)&&isValidSubFields ifo sfs sss soa
-- replace variables with values and do type checking
replaceObjectsVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> [(String,String,String)] -> [RootObject]
replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs]
replaceObjectVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> RootObject -> [(String,String,String)] -> RootObject
replaceObjectVariables sss soa (NestedObject alias name sobject Nothing sfs) vars = NestedObject alias name sobject Nothing [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans Nothing)) sfs) vars = NestedObject alias name sobject (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans (Just arg))) sfs) vars = NestedObject alias name sobject newScalar [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
  where
    newScalar = Just $ ScalarType sAlias sName trans $ Just newValue
    newValue = if isVariable arg then replaceScalarVariable (getScalarTypeForVariableReplacement sobject sName sss soa) arg vars else arg

getScalarTypeForVariableReplacement :: ServerObject -> String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String
getScalarTypeForVariableReplacement obj st ((h,sts):rst) [] = if h==obj then findScalarType st sts else getScalarTypeForVariableReplacement obj st rst []
getScalarTypeForVariableReplacement obj st sss ((pnt,_,(fst:_)):rst) = if pnt==obj then getScalarTypeForVariableReplacement fst st sss [] else getScalarTypeForVariableReplacement obj st sss rst
getScalarTypeForVariableReplacement obj st sss ((pnt,_,[]):rst) = if pnt==obj then throw UnrecognisedObjectException else getScalarTypeForVariableReplacement obj st sss rst
getScalarTypeForVariableReplacement _ _ [] _ = throw UnrecognisedObjectException
findScalarType :: String -> [(String,String,[(String,[(String,String,String,String)])])] -> String
findScalarType st ((name,typ,_):rst) = if st==name then typ else findScalarType st rst
findScalarType _ [] = throw UnrecognisedScalarException

replaceScalarVariable :: String -> String -> [(String,String,String)] -> String
replaceScalarVariable typ arg ((vn,vt,vval):rst)
 | arg==vn&&typ==vt = vval
 | arg==vn = throw MismatchedVariableTypeException
 | otherwise = replaceScalarVariable typ arg rst
replaceScalarVariable _ _ [] = throw UnrecognisedScalarException

replaceSubfieldVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,String)] -> Field -> Field
replaceSubfieldVariables _ _ _ _ (Left (ScalarType alias name trans Nothing)) = Left $ ScalarType alias name trans Nothing
replaceSubfieldVariables sss soa sobj vars (Left (ScalarType alias name trans (Just arg))) = if not $ isVariable arg then Left $ ScalarType alias name trans $ Just arg else Left $ ScalarType alias name trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement sobj name sss soa) arg vars
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj Nothing sfs))) = Right $ Left $ NestedObject alias name nsobj Nothing [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans Nothing)) sfs))) = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans (Just arg))) sfs))) = if (not $ isVariable arg) then Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just arg) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs] else Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement nsobj name sss soa) arg vars) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = Right $ Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss soa ifsobj vars sf | sf<-sfs]
isVariable :: String -> Bool
isVariable = elem '$'

flagOneWay :: [(String,[String],[String])] -> [RootObject] -> [[FlagNode]]
flagOneWay soa robjs = map (\(NestedObject _ _ so _ sfs) -> flagOneWayByRootObj soa so sfs) robjs
flagOneWayByRootObj :: [(String,[String],[String])] -> ServerObject -> [Field] -> [FlagNode]
flagOneWayByRootObj soa so sfs = if isInterface soa so then [flagOneWayRootTable soa (FlagNode 0 []) [] nio sfs [] | nio<-translateInterfaceToServerObjects soa so] else [flagOneWayRootTable soa (FlagNode 0 []) [] so sfs []]
flagOneWayRootTable :: [(String,[String],[String])] -> FlagNode -> [Int] -> ServerObject -> [Field] -> [(ServerObject,[Field])] -> FlagNode
flagOneWayRootTable soa rsf idc so ((Left _):sfs) rem = flagOneWayRootTable soa rsf idc so sfs rem
flagOneWayRootTable soa rsf idc so ((Right (Left (NestedObject _ _ nso _ nsfs))):sfs) rem
  | flg && nNios > 1 = flagOneWayRootTable soa fRlt idc so sfs rem
  | flg && nNios > 0 = flagOneWayRootTable soa u1Rlt (rIdx:idc) (head nios) nsfs nrem
  | flg = flagOneWayRootTable soa u0Rlt idc so sfs rem -- TODO: make an empty query for interfaces without objects
  | otherwise = flagOneWayRootTable soa u1Rlt (rIdx:idc) nso nsfs nrem
 where
    nios = translateInterfaceToServerObjects soa nso
    nNios = length nios
    flg = isInterface soa nso
    u0Rlt = addNodeAndInc 0 rsf idc
    u1Rlt = addNodeAndInc 1 rsf idc
    rIdx = findNextIndex rsf idc
    fRlt = foldl' (\nRlt (nIdx,nObj)->let nU1Rlt = addNodeAndInc 1 nRlt idc in flagOneWayRootTable soa nU1Rlt (nIdx:idc) nObj nsfs []) rsf $ zip [rIdx..] nios
    nrem = (so,sfs):rem
flagOneWayRootTable soa rsf idc so ((Right (Right (InlinefragmentObject nso nsfs))):sfs) rem = if so==nso then flagOneWayRootTable soa rsf idc so (nsfs++sfs) rem else flagOneWayRootTable soa rsf idc so sfs rem
flagOneWayRootTable soa rsf idc so [] ((nso,nsfs):rem) = flagOneWayRootTable soa rsf (tail idc) nso nsfs rem
flagOneWayRootTable soa rsf idc so [] [] = rsf
addNodeAndInc :: Int -> FlagNode -> [Int] -> FlagNode
addNodeAndInc inc rsf idx = updateNodeValues nVal nTree idx
    where
        nTree = addNodeWithInc inc rsf idx
        nVal = findNewVal nTree idx
addNodeWithInc :: Int -> FlagNode -> [Int] -> FlagNode
addNodeWithInc inc (FlagNode val nds) [] = FlagNode (val+inc) (nds++[FlagNode 0 []])
addNodeWithInc inc (FlagNode val nds) (h:t) = FlagNode val [if nIdx/=h then nNode else addNodeWithInc inc nNode t | (nIdx,nNode)<-zip [0..] nds]
findNewVal :: FlagNode -> [Int] -> Int
findNewVal (FlagNode val _) [] = val
findNewVal (FlagNode _ nds) (h:t) = findNewVal ((!!) nds h) t
updateNodeValues :: Int -> FlagNode -> [Int] -> FlagNode
updateNodeValues nVal (FlagNode val nds) (h:t) = FlagNode (max nVal val) [if nIdx/=h then nNode else updateNodeValues nVal nNode t | (nIdx,nNode)<-zip [0..] nds]
updateNodeValues nVal (FlagNode val nds) [] = FlagNode (max nVal val) nds
findNextIndex :: FlagNode -> [Int] -> Int
findNextIndex (FlagNode _ nds) (h:t) = findNextIndex ((!!) nds h) t
findNextIndex (FlagNode _ nds) [] = length nds