module Data.HSet.Union where

import Data.HSet.Remove
import Data.HSet.Type
import Data.HSet.TypeLevel
import Data.Typeable

#if !(MIN_VERSION_base(4, 8, 0))
import Control.Applicative
#endif

class ( fidx ~ (MayFstIndexSnd els1 els2)
      , sidx ~ (MayFstIndexSnd els2 els1) )
      => HUnion els1 els2 elsr fidx sidx
       | els1 els2 fidx sidx -> elsr where
  hunion :: HSet els1 -> HSet els2 -> HSet elsr

instance HUnion '[] '[] '[] 'Nothing 'Nothing where
  hunion _ _ = HSNil

instance HUnion '[] (e ': els) (e ': els) 'Nothing 'Nothing where
  hunion _ a = a

instance HUnion (e ': els) '[] (e ': els) 'Nothing 'Nothing where
  hunion a _ = a

instance ( HUnionable els1 els2 elsr
         , 'False ~ (Elem e1 (e2 ': elsr))
         , 'False ~ (Elem e2 elsr)
         , 'Nothing ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))
         , 'Nothing ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )
         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': e2 ': elsr) 'Nothing 'Nothing where
  hunion (HSCons e1 els1) (HSCons e2 els2) = HSCons e1 $ HSCons e2 $ hunion els1 els2

instance ( HUnionable els1 els2 elsr
         , 'False ~ (Elem e elsr) )
         => HUnion (e ': els1) (e ': els2) (e ': elsr) ('Just 'Z) ('Just 'Z) where
  hunion (HSCons e els1) (HSCons _ els2) = HSCons e $ hunion els1 els2

instance ( HRemove els2 elsx fi
         , HUnionable els1 elsx elsr
         , 'False ~ (Elem e1 elsr)
         , ('Just ('S fi)) ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))
         , ('Just si) ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )
         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': elsr) ('Just ('S fi)) ('Just si) where
  hunion (HSCons e1 els1) (HSCons _ els2) = HSCons e1 $ hunion els1 $ hremove (Proxy :: Proxy fi) els2

instance ( HRemove els2 elsx fi
         , HUnionable els1 elsx elsr
         , 'False ~ (Elem e1 elsr)
         , ('Just fi) ~ (MayFstIndexSnd (e1 ': els1) els2)
         , 'Nothing ~ (MayFstIndexSnd els2 (e1 ': els1)) )
         => HUnion (e1 ': els1) els2 (e1 ': elsr) ('Just fi) 'Nothing where
  hunion (HSCons e1 els1) els2 = HSCons e1 $ hunion els1 $ hremove (Proxy :: Proxy fi) els2

instance ( HUnionable els1 els2 elsr
         , 'False ~ (Elem e1 elsr)
         , 'Nothing ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))
         , ('Just si) ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )
         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': elsr) 'Nothing ('Just si) where
  hunion (HSCons e1 els1) (HSCons _ els2) = HSCons e1 $ hunion els1 els2

type HUnionable els1 els2 elsr =
  HUnion els1 els2 elsr (MayFstIndexSnd els1 els2) (MayFstIndexSnd els2 els1)