-- |
-- Module      : Data.SetLike.Intersection
-- Copyright   : (c) Justus Sagemüller 2016
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 


module Data.SetLike.Intersection where

import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))


newtype IntersectT s x = IntersectT { forall (s :: * -> *) x. IntersectT s x -> NonEmpty (s x)
getIntersectors :: NonEmpty (s x) }


singleIntersect :: s x -> IntersectT s x
singleIntersect :: forall (s :: * -> *) x. s x -> IntersectT s x
singleIntersect = forall (s :: * -> *) x. NonEmpty (s x) -> IntersectT s x
IntersectT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

rmTautologyIntersect ::
         (s x -> s x -> Maybe (s x)) -- ^ Subset-finder
      -> IntersectT s x -> IntersectT s x
rmTautologyIntersect :: forall (s :: * -> *) x.
(s x -> s x -> Maybe (s x)) -> IntersectT s x -> IntersectT s x
rmTautologyIntersect s x -> s x -> Maybe (s x)
smaller (IntersectT NonEmpty (s x)
isoa) = forall (s :: * -> *) x. NonEmpty (s x) -> IntersectT s x
IntersectT forall a b. (a -> b) -> a -> b
$ NonEmpty (s x) -> NonEmpty (s x)
rti NonEmpty (s x)
isoa
 where rti :: NonEmpty (s x) -> NonEmpty (s x)
rti (s x
s₀:|[s x]
ss) = [s x] -> [s x] -> NonEmpty (s x)
reduce [] [s x]
ss
        where reduce :: [s x] -> [s x] -> NonEmpty (s x)
reduce [] [] = s x
s₀forall a. a -> [a] -> NonEmpty a
:|[]
              reduce (s x
sp₀:[s x]
sp) [] = forall a. a -> NonEmpty a -> NonEmpty a
NE.cons s x
s₀ forall a b. (a -> b) -> a -> b
$ NonEmpty (s x) -> NonEmpty (s x)
rti (s x
sp₀forall a. a -> [a] -> NonEmpty a
:|[s x]
sp)
              reduce [s x]
sp (s x
s₁:[s x]
sr) = case s x -> s x -> Maybe (s x)
smaller s x
s₀ s x
s₁ of
               Just s x
si -> NonEmpty (s x) -> NonEmpty (s x)
rti forall a b. (a -> b) -> a -> b
$ s x
si forall a. a -> [a] -> NonEmpty a
:| ([s x]
sp forall a. [a] -> [a] -> [a]
++ [s x]
sr)
               Maybe (s x)
Nothing -> [s x] -> [s x] -> NonEmpty (s x)
reduce (s x
s₁forall a. a -> [a] -> [a]
:[s x]
sp) [s x]
sr