module Components.ObjectHandlers.ServerObjectTrimmer (mergeDuplicatedRootObjects) where

import Control.Exception (throw)
import Model.ServerObjectTypes (
    RootObject,
    NestedObject(..),
    ScalarType,
    Field,
    InlinefragmentObject(..)
  )
import Model.ServerExceptions (
    QueryException(DuplicateObjectsException)
  )
import Components.ObjectHandlers.ObjectsHandler (
    isSameNObjectReference,
    isSameIFObjectReference,
    isSameObjectSubSelection
  )


mergeDuplicatedRootObjects :: [RootObject] -> [RootObject]
mergeDuplicatedRootObjects [] = []
mergeDuplicatedRootObjects robjs = compressROsSubFields $ mergeDuplicatedRootObjectsHelper robjs []
mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper (h:t) rst = mergeDuplicatedRootObjectsHelper differences ((mergeDuplicates h duplicates):rst)
                                           where (duplicates, differences) = separateDuplicatesAndDifferences h t
mergeDuplicatedRootObjectsHelper [] rst = rst
-- 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 (h:t) dup diff
   | (isSameNObjectReference robj h)&&(isSameObjectSubSelection robj h) = separateDuplicatesAndDifferencesHelper robj t (h:dup) diff
   | (isSameNObjectReference robj h) = throw DuplicateObjectsException
   | otherwise = separateDuplicatesAndDifferencesHelper robj t dup (h:diff)
separateDuplicatesAndDifferencesHelper robj [] dup diff = (dup,diff)
-- merge together valid (same reference and same subselection) RootObjects
mergeDuplicates :: RootObject -> [RootObject] -> RootObject
mergeDuplicates (NestedObject alias name sobj ss sf1) ((NestedObject _ _ _ _ sf2):t) = mergeDuplicates (NestedObject alias name sobj ss (sf1++sf2)) t
mergeDuplicates robj [] = robj

compressROsSubFields :: [RootObject] -> [RootObject]
compressROsSubFields ((NestedObject alias name sobj ss sfs):t) = (NestedObject alias name sobj ss $ compressNextDepth $ compressSubFields sfs):(compressROsSubFields t)
compressROsSubFields [] = []
-- from list of Fields to merged duplicate Fields
compressSubFields :: [Field] -> [Field]
compressSubFields [] = []
compressSubFields lst = compressSubFieldsHelper lst []
-- want a removed-duplicate set with a list of Fields, and empty list.
compressSubFieldsHelper :: [Field] -> [Field] -> [Field]
compressSubFieldsHelper ((Left h):t) rst = compressSubFieldsHelper t (combineScalarTypeWithPresent rst h)
compressSubFieldsHelper ((Right (Left h)):t) rst = compressSubFieldsHelper t (combineNestedObjectWithPresent rst h)
compressSubFieldsHelper ((Right (Right h)):t) rst = compressSubFieldsHelper t (combineInlinefragmentObjectWithPresent rst h)
compressSubFieldsHelper [] rst = rst
-- from list of Field and one ScalarType to a union set of list and new ScalarType
combineScalarTypeWithPresent :: [Field] -> ScalarType -> [Field]
combineScalarTypeWithPresent fld st = combineScalarTypeWithPresentHelper fld st []
combineScalarTypeWithPresentHelper :: [Field] -> ScalarType -> [Field] -> [Field]
combineScalarTypeWithPresentHelper ((Left h):t) st acc
  | h==st = acc++((Left h):t)
combineScalarTypeWithPresentHelper (h:t) st acc = combineScalarTypeWithPresentHelper t st $ h:acc
combineScalarTypeWithPresentHelper [] st acc = (Left st):acc
-- from list of Field and one NestedObject to a union set of list and new NestedObject
combineNestedObjectWithPresent :: [Field] -> NestedObject -> [Field]
combineNestedObjectWithPresent fld no = combineNestedObjectWithPresentHelper fld no []
combineNestedObjectWithPresentHelper :: [Field] -> NestedObject -> [Field] -> [Field]
combineNestedObjectWithPresentHelper ((Right (Left h)):t) no acc
  | (isSameNObjectReference h no)&&(isSameObjectSubSelection h no) = ((Right $ Left $ mergeNObjects h no):t)++acc
  | isSameNObjectReference h no = throw DuplicateObjectsException
  | otherwise = combineNestedObjectWithPresentHelper t no ((Right $ Left h):acc)
combineNestedObjectWithPresentHelper (h:t) no acc = combineNestedObjectWithPresentHelper t no (h:acc)
combineNestedObjectWithPresentHelper [] no acc = (Right $ Left no):acc
combineInlinefragmentObjectWithPresent :: [Field] -> InlinefragmentObject -> [Field]
combineInlinefragmentObjectWithPresent ((Right (Left h)):t) ifo = (Right $ Left h):combineInlinefragmentObjectWithPresent t ifo
combineInlinefragmentObjectWithPresent ((Right (Right h)):t) ifo
  | isSameIFObjectReference h ifo = (Right $ Right $ mergeIFObjects h ifo):t
combineInlinefragmentObjectWithPresent (h:t) ifo = h:combineInlinefragmentObjectWithPresent t ifo
combineInlinefragmentObjectWithPresent [] ifo = [Right $ Right ifo]
-- one NestedObject that is same reference, same SubSelection and union set subfields with two NestedObjects that are same reference (alias, name, and ServerObject) and same SubSelection.
mergeNObjects :: NestedObject -> NestedObject -> NestedObject
mergeNObjects (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 (sfs1++sfs2) else error "Requested object merge is for different things (source error)."
-- one InlinefragmentObject that is same ServerObject and is union set subfields with two InlinefragmentObjects that are same reference (ServerObject)
mergeIFObjects :: InlinefragmentObject -> InlinefragmentObject -> InlinefragmentObject
mergeIFObjects (InlinefragmentObject sobj1 sfs1) (InlinefragmentObject sobj2 sfs2) = if sobj1==sobj2 then InlinefragmentObject sobj1 (sfs1++sfs2) else error "Requested object merge is for different things (source error)."
compressNextDepth :: [Field] -> [Field]
compressNextDepth ((Left h):t) = (Left h):(compressNextDepth t)
compressNextDepth ((Right (Left (NestedObject alias name sobj ss sfs))):t) = (Right (Left (NestedObject alias name sobj ss $ compressNextDepth $ compressSubFields sfs))):(compressNextDepth t)
compressNextDepth ((Right (Right (InlinefragmentObject sobj sfs))):t) = (Right (Right (InlinefragmentObject sobj $ compressNextDepth $ compressSubFields sfs))):(compressNextDepth t)
compressNextDepth [] = []