module Components.ObjectHandlers.ServerObjectTrimmer (mergeDuplicatedRootObjects) where

import Data.Either
import qualified Control.Exception as E
import Model.ServerObjectTypes
import Model.ServerExceptions
import Components.ObjectHandlers.ObjectsHandler


mergeDuplicatedRootObjects :: [RootObject] -> [RootObject]
mergeDuplicatedRootObjects [] = []
-- TODO: replace all check-then-process to single process...
mergeDuplicatedRootObjects robjs = mergeDuplicatedRootObjectsHelper robjs []
mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper [] rst = rst
mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences (rst++[(mergeDuplicates h duplicates)])
                                           where (duplicates, differences) = separateDuplicatesAndDifferences h t
-- we want two lists of duplicates and differences
separateDuplicatesAndDifferences :: RootObject -> [RootObject] -> ([RootObject],[RootObject])
separateDuplicatesAndDifferences robj [] = ([],[])
separateDuplicatesAndDifferences robj lst = separateDuplicatesAndDifferencesHelper robj lst [] []
separateDuplicatesAndDifferencesHelper :: RootObject -> [RootObject] -> [RootObject] -> [RootObject] -> ([RootObject],[RootObject])
separateDuplicatesAndDifferencesHelper robj [] dup diff = (dup,diff)
separateDuplicatesAndDifferencesHelper robj (h:t) dup diff
   | (isSameObjectReference robj h)&&(isSameObjectSubSelection robj h) = separateDuplicatesAndDifferencesHelper robj t (h:dup) diff
   | (isSameObjectReference robj h) = E.throw DuplicateRootObjectsException
   | otherwise = separateDuplicatesAndDifferencesHelper robj t dup (h:diff)
-- merge together valid (same referene and same subselection) RootObjects
mergeDuplicates :: RootObject -> [RootObject] -> RootObject
mergeDuplicates robj [] = (mergeSubFields robj)
mergeDuplicates (NestedObject alias name sobj ss sf1) ((NestedObject _ _ _ _ sf2):t) = mergeDuplicates (NestedObject alias name sobj ss (mergeFields sf1 sf2)) t
-- merge SubFields in one RootObject
mergeSubFields :: RootObject -> RootObject
mergeSubFields (NestedObject alias name sobj ss sfs) = (NestedObject alias name sobj ss (compressSubSelections sfs))
-- with a list of Fields, we want to merge duplicate Fields
compressSubSelections :: [Field] -> [Field]
compressSubSelections [] = []
compressSubSelections lst = compressSubSelectionsHelper lst []
-- We want a removed-duplicate set with a list of Fields, and empty list/.
compressSubSelectionsHelper :: [Field] -> [Field] -> [Field]
compressSubSelectionsHelper [] rst = rst
compressSubSelectionsHelper (h:t) rst
    | (isLeft h) = compressSubSelectionsHelper t (combineScalarTypeWithPresent rst st)
    | otherwise = compressSubSelectionsHelper t (combineNestedObjectWithPresent rst no)
  where
    st = (fromLeft (E.throw InvalidScalarException) h)
    no = (fromRight (E.throw InvalidObjectException) h)
-- with two sets of fields, we want a union that is no duplicates
mergeFields :: [Field] -> [Field] -> [Field]
mergeFields lst [] = lst
mergeFields lst (h:t)
    | (isLeft h)==True = mergeFields (combineScalarTypeWithPresent lst (fromLeft (E.throw InvalidScalarException) h)) t
    | otherwise = mergeFields (combineNestedObjectWithPresent lst (fromRight (E.throw InvalidObjectException) h)) t
-- with list of Field and one ScalarType, we want a union set of list and new ScalarType
combineScalarTypeWithPresent :: [Field] -> ScalarType -> [Field]
combineScalarTypeWithPresent [] st = (Left st):[]
combineScalarTypeWithPresent (h:t) st
    | (isLeft h)&&(fromLeft (E.throw InvalidScalarException) h)==st = h:t
    | otherwise = h:(combineScalarTypeWithPresent t st)
-- with list of Field and one NestedObject, we want a union set of list and new NestedObject
combineNestedObjectWithPresent :: [Field] -> NestedObject -> [Field]
combineNestedObjectWithPresent [] no = (Right no):[]
combineNestedObjectWithPresent (h:t) no
    | (isRight h)&&(isSameObjectReference nobj no)&&(isSameObjectSubSelection nobj no) = (Right $ mergeObjects nobj no):t
    | (isRight h)&&(isSameObjectReference nobj no) = E.throw DuplicateRootObjectsException
    | otherwise = h:(combineNestedObjectWithPresent t no)
  where
    nobj = (fromRight (E.throw InvalidObjectException) h)
-- we want one NestedObject that is same reference, same SubSelection and union set subfields with two NestObjects that are same reference (alias, name, and ServerObject) and same SubSelection.
mergeObjects :: NestedObject -> NestedObject -> NestedObject
mergeObjects (NestedObject alias1 name1 sobj1 ss1 sfs1) (NestedObject alias2 name2 sobj2 ss2 sfs2) = if (alias1==alias2&&name1==name2&&sobj1==sobj2&&ss1==ss2) then (NestedObject alias1 name1 sobj1 ss1 (mergeFields sfs1 sfs2)) else (E.throw FailedObjectEqualityException)