module Hunt.Common.Positions where
import Control.Applicative ((<$>))
import Control.DeepSeq
import Data.Aeson
import Data.Binary as B
import qualified Data.IntSet as IS
import Data.IntSet.Cache as IS
import Data.Maybe (fromMaybe)
import Data.Monoid ()
import Data.Typeable
import Hunt.Common.BasicTypes
newtype Positions
= PS {unPS :: IS.IntSet}
deriving (Eq, Ord, Read, Show, Typeable, NFData, Monoid)
instance B.Binary Positions where
put = B.put . toAscList
get = fromList <$> B.get
instance ToJSON Positions where
toJSON = toJSON . unPS
empty :: Positions
empty = PS IS.empty
singleton :: Position -> Positions
singleton = PS . IS.cacheAt
null :: Positions -> Bool
null = IS.null . unPS
member :: Position -> Positions -> Bool
member p = IS.member p . unPS
toAscList :: Positions -> [Position]
toAscList = IS.toAscList . unPS
fromList :: [Position] -> Positions
fromList = PS . IS.unions . map IS.cacheAt
size :: Positions -> Int
size = IS.size . unPS
union :: Positions -> Positions -> Positions
union s1 s2 = PS $ (unPS s1) `IS.union` (unPS s2)
intersection :: Positions -> Positions -> Positions
intersection s1 s2 = PS $ (unPS s1) `IS.intersection` (unPS s2)
difference :: Positions -> Positions -> Positions
difference s1 s2 = PS $ (unPS s1) `IS.difference` (unPS s2)
foldr :: (Position -> r -> r) -> r -> Positions -> r
foldr op e = IS.foldr op e . unPS
intersectionWithDispl :: Int -> Positions -> Positions -> Positions
intersectionWithDispl d (PS s1) (PS s2)
= PS $ IS.filter member' s1
where
member' i = (i + d) `IS.member` s2
intersectionWithIntervall :: Int -> Int -> Positions -> Positions -> Positions
intersectionWithIntervall lb ub (PS s1) (PS s2)
= PS $ IS.filter member' s1
where
member' i = minElem <= i + ub
where
(_ls, gt) = IS.split (i + lb 1) s2
minElem = fromMaybe (i + ub + 1) $ fst <$> IS.minView gt