{-# LANGUAGE Safe #-}
module Data.Range.Data where
data OverlapType = Separate | Overlap | Adjoin
deriving (Eq, Show)
data BoundType
= Inclusive
| Exclusive
deriving (Eq, Show)
data Bound a = Bound
{ boundValue :: a
, boundType :: BoundType
} deriving (Eq, Show)
instance Functor Bound where
fmap f (Bound v vType) = Bound (f v) vType
data Range a
= SingletonRange a
| SpanRange (Bound a) (Bound a)
| LowerBoundRange (Bound a)
| UpperBoundRange (Bound a)
| InfiniteRange
deriving(Eq)
instance Functor Range where
fmap f (SingletonRange x) = SingletonRange . f $ x
fmap f (SpanRange x y) = SpanRange (fmap f x) (fmap f y)
fmap f (LowerBoundRange x) = LowerBoundRange (fmap f x)
fmap f (UpperBoundRange x) = UpperBoundRange (fmap f x)
fmap _ InfiniteRange = InfiniteRange
instance Show a => Show (Range a) where
showsPrec i (SingletonRange a) = ((++) "SingletonRange ") . showsPrec i a
showsPrec i (SpanRange (Bound l lType) (Bound r rType)) =
showsPrec i l . showSymbol lType rType . showsPrec i r
where
showSymbol Inclusive Inclusive = (++) " +=+ "
showSymbol Inclusive Exclusive = (++) " +=* "
showSymbol Exclusive Inclusive = (++) " *=+ "
showSymbol Exclusive Exclusive = (++) " *=* "
showsPrec i (LowerBoundRange (Bound a Inclusive)) = ((++) "lbi ") . (showsPrec i a)
showsPrec i (LowerBoundRange (Bound a Exclusive)) = ((++) "lbe ") . (showsPrec i a)
showsPrec i (UpperBoundRange (Bound a Inclusive)) = ((++) "ubi ") . (showsPrec i a)
showsPrec i (UpperBoundRange (Bound a Exclusive)) = ((++) "ube ") . (showsPrec i a)
showsPrec _ (InfiniteRange) = (++) "inf"