{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.Range.Algebra.Internal where
import Prelude hiding (const)
import Data.Range.Data
import Data.Range.RangeInternal
import Control.Monad.Free
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
#endif
data RangeExprF r
= Invert r
| Union r r
| Intersection r r
| Difference r r
deriving (Show, Eq, Functor)
#if MIN_VERSION_base(4,9,0)
instance Eq1 RangeExprF where
liftEq eq (Invert a) (Invert b) = eq a b
liftEq eq (Union a c) (Union b d) = eq a b && eq c d
liftEq eq (Intersection a c) (Intersection b d) = eq a b && eq c d
liftEq eq (Difference a c) (Difference b d) = eq a b && eq c d
liftEq _ _ _ = False
instance Show1 RangeExprF where
liftShowsPrec showPrec showList p (Invert x) = showString "not " . showParen True (showPrec (p + 1) x)
liftShowsPrec showPrec showList p (Union a b) =
showPrec (p + 1) a .
showString " \\/ " .
showPrec (p + 1) b
liftShowsPrec showPrec showList p (Intersection a b) =
showPrec (p + 1) a .
showString " /\\ " .
showPrec (p + 1) b
liftShowsPrec showPrec showList p (Difference a b) =
showPrec (p + 1) a .
showString " - " .
showPrec (p + 1) b
#endif
newtype RangeExpr a = RangeExpr { getFree :: Free RangeExprF a }
deriving (Show, Eq, Functor)
type Algebra f a = f a -> a
rangeMergeAlgebra :: (Ord a, Enum a) => Algebra RangeExprF (RangeMerge a)
rangeMergeAlgebra (Invert a) = invertRM a
rangeMergeAlgebra (Union a b) = a `unionRangeMerges` b
rangeMergeAlgebra (Intersection a b) = a `intersectionRangeMerges` b
rangeMergeAlgebra (Difference a b) = a `intersectionRangeMerges` invertRM b