{-# LANGUAGE CPP #-}
module Mask where

import Control.Monad
import Debug.Trace
import Data.Int
import qualified Data.List as List
import Data.List.Merge

-- Start index , count
newtype Mask = Mask [(Int32,Int32)]
 deriving (Eq,Ord,Show)

subtr xs ys =
    let xxs = concatMap (\(a,b) -> [(a,1),(b,2)]) xs
        yys = concatMap (\(a,b) -> [(a,4),(b,3)]) ys
        zzs = mergeL xxs yys -- xxx: we really want (comparing fst)
        zs = foldr subtr4 (const []) zzs (False,False)
    in filter (uncurry (/=)) $ pairs zs

subtr4 (x,1) f (False,iny)  = (if not iny then (x:) else id) $ f (True,iny)
subtr4 (x,2) f (True,iny)   = (if not iny then (x:) else id) $ f (False,iny)
subtr4 (x,3) f (inx,True)   = (if inx then (x:) else id) $ f (inx,False)
subtr4 (x,4) f (inx,False)  = (if inx then (x:) else id) $ f (inx,True)
subtr4 _     f inxy         = f inxy

pairs :: [a] -> [(a,a)]
pairs (x:y:ys) = (x,y) : pairs ys
pairs _ = []


union1 ab [] = (ab,[])
union1 (a,b) ((x0,x):xs) =
    if x0 <= b
        then union1 (a,max x b) xs
        else ((a,b),(x0,x):xs)

union [] ys = ys
union xs [] = xs
union xs@((x0,_):_) ys@((y0,_):_) | y0<x0 = union ys xs
union (x:xs) ys =
    let (x',ys') = union1 x ys
        (z@(_,e),xs') = union1 x' xs
    in if all (\(f,_) -> e < f) (take 1 ys' ++ take 1 xs')
        then z : union xs' ys'
        else union (z:xs') ys'


endpts :: (Int32,Int32) -> (Int32,Int32)
endpts (x0,sz) = (x0,x0 + sz)

sized :: (Int32,Int32) -> (Int32,Int32)
sized (x0,x) = (x0, x - x0)

maskPlus :: Mask -> Mask -> Mask
maskPlus (Mask xs) (Mask ys) =
    let zs = sized <$> union (endpts <$> xs) (endpts <$> ys)
    in Mask zs

maskSubtract :: Mask -> Mask -> Mask
maskSubtract (Mask xs) (Mask ys) =
    let zs = sized <$> subtr (endpts <$> xs) (endpts <$> ys)
    in Mask zs