ServerObjectTrimmer.hs

module Components.ObjectHandlers.ServerObjectTrimmer (mergeDuplicatedRootObjects) where

import Model.ServerObjectTypes (
    RootObject,
    RootObjects,
    NestedObject(..),
    ScalarType,
    Field,
    FieldObject,
    InlinefragmentObject(..)
  )
import Model.ServerExceptions (
    QueryException(
      InvalidObjectException,
      InvalidScalarException,
      DuplicateRootObjectsException,
      FailedObjectEqualityException
    )
  )
import Components.ObjectHandlers.ObjectsHandler (
    isSameNObjectReference,
    isSameIFObjectReference,
    isSameObjectSubSelection
  )
import Data.Either (
    fromLeft,
    fromRight,
    isLeft,
    isRight,
    Either(Left,Right)
  )
import Control.Exception (throw)


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
   | (isSameNObjectReference robj h)&&(isSameObjectSubSelection robj h) = separateDuplicatesAndDifferencesHelper robj t (h:dup) diff
   | (isSameNObjectReference robj h) = 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 (combineFieldObjectWithPresent rst fo)
  where
    st = (fromLeft (throw InvalidScalarException) h)
    fo = (fromRight (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 (throw InvalidScalarException) h)) t
    | otherwise = mergeFields (combineFieldObjectWithPresent lst (fromRight (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 (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
combineFieldObjectWithPresent :: [Field] -> FieldObject -> [Field]
combineFieldObjectWithPresent [] fo = (Right fo):[]
combineFieldObjectWithPresent (h:t) fo
    | (isLeft h) = h:(combineFieldObjectWithPresent t fo)
    | (isLeft fobj)&&(isRight fo) = h:(combineFieldObjectWithPresent t fo)
    | (isLeft fo)&&(isRight fobj) = h:(combineFieldObjectWithPresent t fo)
    | (isLeft fobj)&&(isSameNObjectReference nobj lnobj)&&(isSameObjectSubSelection nobj lnobj) = (Right $ Left $ mergeNObjects nobj lnobj):t
    | (isLeft fobj)&&(isSameNObjectReference nobj lnobj) = throw DuplicateRootObjectsException
    | (isLeft fobj) = h:(combineFieldObjectWithPresent t fo)
    | (isSameIFObjectReference ifobj lifobj) = (Right $ Right $ mergeIFObjects ifobj lifobj):t
    | otherwise = h:(combineFieldObjectWithPresent t fo)
  where
    fobj = fromRight (throw InvalidObjectException) h
    lnobj = fromLeft (throw InvalidObjectException) fobj
    lifobj = fromRight (throw InvalidObjectException) fobj
    nobj = fromLeft (throw InvalidObjectException) fo
    ifobj = fromRight (throw InvalidObjectException) fo
-- we want 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 (mergeFields sfs1 sfs2)) else (throw FailedObjectEqualityException)
-- we want 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 (mergeFields sfs1 sfs2)) else (throw FailedObjectEqualityException)