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 :: [RootObject] -> [RootObject]
mergeDuplicatedRootObjects [] = []
mergeDuplicatedRootObjects robjs :: [RootObject]
robjs = [RootObject] -> [RootObject]
compressROsSubFields ([RootObject] -> [RootObject]) -> [RootObject] -> [RootObject]
forall a b. (a -> b) -> a -> b
$ [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper [RootObject]
robjs []
mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper :: [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper (h :: RootObject
h:t :: [RootObject]
t) rst :: [RootObject]
rst = [RootObject] -> [RootObject] -> [RootObject]
mergeDuplicatedRootObjectsHelper [RootObject]
differences ((RootObject -> [RootObject] -> RootObject
mergeDuplicates RootObject
h [RootObject]
duplicates)RootObject -> [RootObject] -> [RootObject]
forall a. a -> [a] -> [a]
:[RootObject]
rst)
                                           where (duplicates :: [RootObject]
duplicates, differences :: [RootObject]
differences) = RootObject -> [RootObject] -> ([RootObject], [RootObject])
separateDuplicatesAndDifferences RootObject
h [RootObject]
t
mergeDuplicatedRootObjectsHelper [] rst :: [RootObject]
rst = [RootObject]
rst
-- two lists of duplicates and differences
separateDuplicatesAndDifferences :: RootObject -> [RootObject] -> ([RootObject],[RootObject])
separateDuplicatesAndDifferences :: RootObject -> [RootObject] -> ([RootObject], [RootObject])
separateDuplicatesAndDifferences robj :: RootObject
robj [] = ([],[])
separateDuplicatesAndDifferences robj :: RootObject
robj lst :: [RootObject]
lst = RootObject
-> [RootObject]
-> [RootObject]
-> [RootObject]
-> ([RootObject], [RootObject])
separateDuplicatesAndDifferencesHelper RootObject
robj [RootObject]
lst [] []
separateDuplicatesAndDifferencesHelper :: RootObject -> [RootObject] -> [RootObject] -> [RootObject] -> ([RootObject],[RootObject])
separateDuplicatesAndDifferencesHelper :: RootObject
-> [RootObject]
-> [RootObject]
-> [RootObject]
-> ([RootObject], [RootObject])
separateDuplicatesAndDifferencesHelper robj :: RootObject
robj (h :: RootObject
h:t :: [RootObject]
t) dup :: [RootObject]
dup diff :: [RootObject]
diff
   | (RootObject -> RootObject -> Bool
isSameNObjectReference RootObject
robj RootObject
h)Bool -> Bool -> Bool
&&(RootObject -> RootObject -> Bool
isSameObjectSubSelection RootObject
robj RootObject
h) = RootObject
-> [RootObject]
-> [RootObject]
-> [RootObject]
-> ([RootObject], [RootObject])
separateDuplicatesAndDifferencesHelper RootObject
robj [RootObject]
t (RootObject
hRootObject -> [RootObject] -> [RootObject]
forall a. a -> [a] -> [a]
:[RootObject]
dup) [RootObject]
diff
   | (RootObject -> RootObject -> Bool
isSameNObjectReference RootObject
robj RootObject
h) = QueryException -> ([RootObject], [RootObject])
forall a e. Exception e => e -> a
throw QueryException
DuplicateObjectsException
   | Bool
otherwise = RootObject
-> [RootObject]
-> [RootObject]
-> [RootObject]
-> ([RootObject], [RootObject])
separateDuplicatesAndDifferencesHelper RootObject
robj [RootObject]
t [RootObject]
dup (RootObject
hRootObject -> [RootObject] -> [RootObject]
forall a. a -> [a] -> [a]
:[RootObject]
diff)
separateDuplicatesAndDifferencesHelper robj :: RootObject
robj [] dup :: [RootObject]
dup diff :: [RootObject]
diff = ([RootObject]
dup,[RootObject]
diff)
-- merge together valid (same reference and same subselection) RootObjects
mergeDuplicates :: RootObject -> [RootObject] -> RootObject
mergeDuplicates :: RootObject -> [RootObject] -> RootObject
mergeDuplicates (NestedObject alias :: Alias
alias name :: Name
name sobj :: Name
sobj ss :: SubSelection
ss sf1 :: SubFields
sf1) ((NestedObject _ _ _ _ sf2 :: SubFields
sf2):t :: [RootObject]
t) = RootObject -> [RootObject] -> RootObject
mergeDuplicates (Alias -> Name -> Name -> SubSelection -> SubFields -> RootObject
NestedObject Alias
alias Name
name Name
sobj SubSelection
ss (SubFields
sf1SubFields -> SubFields -> SubFields
forall a. [a] -> [a] -> [a]
++SubFields
sf2)) [RootObject]
t
mergeDuplicates robj :: RootObject
robj [] = RootObject
robj

compressROsSubFields :: [RootObject] -> [RootObject]
compressROsSubFields :: [RootObject] -> [RootObject]
compressROsSubFields ((NestedObject alias :: Alias
alias name :: Name
name sobj :: Name
sobj ss :: SubSelection
ss sfs :: SubFields
sfs):t :: [RootObject]
t) = (Alias -> Name -> Name -> SubSelection -> SubFields -> RootObject
NestedObject Alias
alias Name
name Name
sobj SubSelection
ss (SubFields -> RootObject) -> SubFields -> RootObject
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressNextDepth (SubFields -> SubFields) -> SubFields -> SubFields
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressSubFields SubFields
sfs)RootObject -> [RootObject] -> [RootObject]
forall a. a -> [a] -> [a]
:([RootObject] -> [RootObject]
compressROsSubFields [RootObject]
t)
compressROsSubFields [] = []
-- from list of Fields to merged duplicate Fields
compressSubFields :: [Field] -> [Field]
compressSubFields :: SubFields -> SubFields
compressSubFields [] = []
compressSubFields lst :: SubFields
lst = SubFields -> SubFields -> SubFields
compressSubFieldsHelper SubFields
lst []
-- want a removed-duplicate set with a list of Fields, and empty list.
compressSubFieldsHelper :: [Field] -> [Field] -> [Field]
compressSubFieldsHelper :: SubFields -> SubFields -> SubFields
compressSubFieldsHelper ((Left h :: ScalarType
h):t :: SubFields
t) rst :: SubFields
rst = SubFields -> SubFields -> SubFields
compressSubFieldsHelper SubFields
t (SubFields -> ScalarType -> SubFields
combineScalarTypeWithPresent SubFields
rst ScalarType
h)
compressSubFieldsHelper ((Right (Left h :: RootObject
h)):t :: SubFields
t) rst :: SubFields
rst = SubFields -> SubFields -> SubFields
compressSubFieldsHelper SubFields
t (SubFields -> RootObject -> SubFields
combineNestedObjectWithPresent SubFields
rst RootObject
h)
compressSubFieldsHelper ((Right (Right h :: InlinefragmentObject
h)):t :: SubFields
t) rst :: SubFields
rst = SubFields -> SubFields -> SubFields
compressSubFieldsHelper SubFields
t (SubFields -> InlinefragmentObject -> SubFields
combineInlinefragmentObjectWithPresent SubFields
rst InlinefragmentObject
h)
compressSubFieldsHelper [] rst :: SubFields
rst = SubFields
rst
-- from list of Field and one ScalarType to a union set of list and new ScalarType
combineScalarTypeWithPresent :: [Field] -> ScalarType -> [Field]
combineScalarTypeWithPresent :: SubFields -> ScalarType -> SubFields
combineScalarTypeWithPresent fld :: SubFields
fld st :: ScalarType
st = SubFields -> ScalarType -> SubFields -> SubFields
combineScalarTypeWithPresentHelper SubFields
fld ScalarType
st []
combineScalarTypeWithPresentHelper :: [Field] -> ScalarType -> [Field] -> [Field]
combineScalarTypeWithPresentHelper :: SubFields -> ScalarType -> SubFields -> SubFields
combineScalarTypeWithPresentHelper ((Left h :: ScalarType
h):t :: SubFields
t) st :: ScalarType
st acc :: SubFields
acc
  | ScalarType
hScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
==ScalarType
st = SubFields
accSubFields -> SubFields -> SubFields
forall a. [a] -> [a] -> [a]
++((ScalarType -> Either ScalarType FieldObject
forall a b. a -> Either a b
Left ScalarType
h)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
t)
combineScalarTypeWithPresentHelper (h :: Either ScalarType FieldObject
h:t :: SubFields
t) st :: ScalarType
st acc :: SubFields
acc = SubFields -> ScalarType -> SubFields -> SubFields
combineScalarTypeWithPresentHelper SubFields
t ScalarType
st (SubFields -> SubFields) -> SubFields -> SubFields
forall a b. (a -> b) -> a -> b
$ Either ScalarType FieldObject
hEither ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
acc
combineScalarTypeWithPresentHelper [] st :: ScalarType
st acc :: SubFields
acc = (ScalarType -> Either ScalarType FieldObject
forall a b. a -> Either a b
Left ScalarType
st)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
acc
-- from list of Field and one NestedObject to a union set of list and new NestedObject
combineNestedObjectWithPresent :: [Field] -> NestedObject -> [Field]
combineNestedObjectWithPresent :: SubFields -> RootObject -> SubFields
combineNestedObjectWithPresent fld :: SubFields
fld no :: RootObject
no = SubFields -> RootObject -> SubFields -> SubFields
combineNestedObjectWithPresentHelper SubFields
fld RootObject
no []
combineNestedObjectWithPresentHelper :: [Field] -> NestedObject -> [Field] -> [Field]
combineNestedObjectWithPresentHelper :: SubFields -> RootObject -> SubFields -> SubFields
combineNestedObjectWithPresentHelper ((Right (Left h :: RootObject
h)):t :: SubFields
t) no :: RootObject
no acc :: SubFields
acc
  | (RootObject -> RootObject -> Bool
isSameNObjectReference RootObject
h RootObject
no)Bool -> Bool -> Bool
&&(RootObject -> RootObject -> Bool
isSameObjectSubSelection RootObject
h RootObject
no) = ((FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ RootObject -> FieldObject
forall a b. a -> Either a b
Left (RootObject -> FieldObject) -> RootObject -> FieldObject
forall a b. (a -> b) -> a -> b
$ RootObject -> RootObject -> RootObject
mergeNObjects RootObject
h RootObject
no)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
t)SubFields -> SubFields -> SubFields
forall a. [a] -> [a] -> [a]
++SubFields
acc
  | RootObject -> RootObject -> Bool
isSameNObjectReference RootObject
h RootObject
no = QueryException -> SubFields
forall a e. Exception e => e -> a
throw QueryException
DuplicateObjectsException
  | Bool
otherwise = SubFields -> RootObject -> SubFields -> SubFields
combineNestedObjectWithPresentHelper SubFields
t RootObject
no ((FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ RootObject -> FieldObject
forall a b. a -> Either a b
Left RootObject
h)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
acc)
combineNestedObjectWithPresentHelper (h :: Either ScalarType FieldObject
h:t :: SubFields
t) no :: RootObject
no acc :: SubFields
acc = SubFields -> RootObject -> SubFields -> SubFields
combineNestedObjectWithPresentHelper SubFields
t RootObject
no (Either ScalarType FieldObject
hEither ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
acc)
combineNestedObjectWithPresentHelper [] no :: RootObject
no acc :: SubFields
acc = (FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ RootObject -> FieldObject
forall a b. a -> Either a b
Left RootObject
no)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
acc
combineInlinefragmentObjectWithPresent :: [Field] -> InlinefragmentObject -> [Field]
combineInlinefragmentObjectWithPresent :: SubFields -> InlinefragmentObject -> SubFields
combineInlinefragmentObjectWithPresent ((Right (Left h :: RootObject
h)):t :: SubFields
t) ifo :: InlinefragmentObject
ifo = (FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ RootObject -> FieldObject
forall a b. a -> Either a b
Left RootObject
h)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields -> InlinefragmentObject -> SubFields
combineInlinefragmentObjectWithPresent SubFields
t InlinefragmentObject
ifo
combineInlinefragmentObjectWithPresent ((Right (Right h :: InlinefragmentObject
h)):t :: SubFields
t) ifo :: InlinefragmentObject
ifo
  | InlinefragmentObject -> InlinefragmentObject -> Bool
isSameIFObjectReference InlinefragmentObject
h InlinefragmentObject
ifo = (FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ InlinefragmentObject -> FieldObject
forall a b. b -> Either a b
Right (InlinefragmentObject -> FieldObject)
-> InlinefragmentObject -> FieldObject
forall a b. (a -> b) -> a -> b
$ InlinefragmentObject
-> InlinefragmentObject -> InlinefragmentObject
mergeIFObjects InlinefragmentObject
h InlinefragmentObject
ifo)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields
t
combineInlinefragmentObjectWithPresent (h :: Either ScalarType FieldObject
h:t :: SubFields
t) ifo :: InlinefragmentObject
ifo = Either ScalarType FieldObject
hEither ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:SubFields -> InlinefragmentObject -> SubFields
combineInlinefragmentObjectWithPresent SubFields
t InlinefragmentObject
ifo
combineInlinefragmentObjectWithPresent [] ifo :: InlinefragmentObject
ifo = [FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (FieldObject -> Either ScalarType FieldObject)
-> FieldObject -> Either ScalarType FieldObject
forall a b. (a -> b) -> a -> b
$ InlinefragmentObject -> FieldObject
forall a b. b -> Either a b
Right InlinefragmentObject
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 :: RootObject -> RootObject -> RootObject
mergeNObjects (NestedObject alias1 :: Alias
alias1 name1 :: Name
name1 sobj1 :: Name
sobj1 ss1 :: SubSelection
ss1 sfs1 :: SubFields
sfs1) (NestedObject alias2 :: Alias
alias2 name2 :: Name
name2 sobj2 :: Name
sobj2 ss2 :: SubSelection
ss2 sfs2 :: SubFields
sfs2) = if Alias
alias1Alias -> Alias -> Bool
forall a. Eq a => a -> a -> Bool
==Alias
alias2Bool -> Bool -> Bool
&&Name
name1Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
name2Bool -> Bool -> Bool
&&Name
sobj1Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
sobj2Bool -> Bool -> Bool
&&SubSelection
ss1SubSelection -> SubSelection -> Bool
forall a. Eq a => a -> a -> Bool
==SubSelection
ss2 then Alias -> Name -> Name -> SubSelection -> SubFields -> RootObject
NestedObject Alias
alias1 Name
name1 Name
sobj1 SubSelection
ss1 (SubFields
sfs1SubFields -> SubFields -> SubFields
forall a. [a] -> [a] -> [a]
++SubFields
sfs2) else Name -> RootObject
forall a. HasCallStack => Name -> a
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
-> InlinefragmentObject -> InlinefragmentObject
mergeIFObjects (InlinefragmentObject sobj1 :: Name
sobj1 sfs1 :: SubFields
sfs1) (InlinefragmentObject sobj2 :: Name
sobj2 sfs2 :: SubFields
sfs2) = if Name
sobj1Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
sobj2 then Name -> SubFields -> InlinefragmentObject
InlinefragmentObject Name
sobj1 (SubFields
sfs1SubFields -> SubFields -> SubFields
forall a. [a] -> [a] -> [a]
++SubFields
sfs2) else Name -> InlinefragmentObject
forall a. HasCallStack => Name -> a
error "Requested object merge is for different things (source error)."
compressNextDepth :: [Field] -> [Field]
compressNextDepth :: SubFields -> SubFields
compressNextDepth ((Left h :: ScalarType
h):t :: SubFields
t) = (ScalarType -> Either ScalarType FieldObject
forall a b. a -> Either a b
Left ScalarType
h)Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:(SubFields -> SubFields
compressNextDepth SubFields
t)
compressNextDepth ((Right (Left (NestedObject alias :: Alias
alias name :: Name
name sobj :: Name
sobj ss :: SubSelection
ss sfs :: SubFields
sfs))):t :: SubFields
t) = (FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (RootObject -> FieldObject
forall a b. a -> Either a b
Left (Alias -> Name -> Name -> SubSelection -> SubFields -> RootObject
NestedObject Alias
alias Name
name Name
sobj SubSelection
ss (SubFields -> RootObject) -> SubFields -> RootObject
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressNextDepth (SubFields -> SubFields) -> SubFields -> SubFields
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressSubFields SubFields
sfs)))Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:(SubFields -> SubFields
compressNextDepth SubFields
t)
compressNextDepth ((Right (Right (InlinefragmentObject sobj :: Name
sobj sfs :: SubFields
sfs))):t :: SubFields
t) = (FieldObject -> Either ScalarType FieldObject
forall a b. b -> Either a b
Right (InlinefragmentObject -> FieldObject
forall a b. b -> Either a b
Right (Name -> SubFields -> InlinefragmentObject
InlinefragmentObject Name
sobj (SubFields -> InlinefragmentObject)
-> SubFields -> InlinefragmentObject
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressNextDepth (SubFields -> SubFields) -> SubFields -> SubFields
forall a b. (a -> b) -> a -> b
$ SubFields -> SubFields
compressSubFields SubFields
sfs)))Either ScalarType FieldObject -> SubFields -> SubFields
forall a. a -> [a] -> [a]
:(SubFields -> SubFields
compressNextDepth SubFields
t)
compressNextDepth [] = []