{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
module Data.Range.Typed.Algebra.Internal where
import Control.Monad.Free
import Data.Functor.Classes
import Data.Range.Typed.RangeInternal
import Prelude hiding (const)
data RangeExprF r
= Invert r
| Union r r
| Intersection r r
| Difference r r
deriving (Int -> RangeExprF r -> ShowS
[RangeExprF r] -> ShowS
RangeExprF r -> String
(Int -> RangeExprF r -> ShowS)
-> (RangeExprF r -> String)
-> ([RangeExprF r] -> ShowS)
-> Show (RangeExprF r)
forall r. Show r => Int -> RangeExprF r -> ShowS
forall r. Show r => [RangeExprF r] -> ShowS
forall r. Show r => RangeExprF r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> RangeExprF r -> ShowS
showsPrec :: Int -> RangeExprF r -> ShowS
$cshow :: forall r. Show r => RangeExprF r -> String
show :: RangeExprF r -> String
$cshowList :: forall r. Show r => [RangeExprF r] -> ShowS
showList :: [RangeExprF r] -> ShowS
Show, RangeExprF r -> RangeExprF r -> Bool
(RangeExprF r -> RangeExprF r -> Bool)
-> (RangeExprF r -> RangeExprF r -> Bool) -> Eq (RangeExprF r)
forall r. Eq r => RangeExprF r -> RangeExprF r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => RangeExprF r -> RangeExprF r -> Bool
== :: RangeExprF r -> RangeExprF r -> Bool
$c/= :: forall r. Eq r => RangeExprF r -> RangeExprF r -> Bool
/= :: RangeExprF r -> RangeExprF r -> Bool
Eq, (forall a b. (a -> b) -> RangeExprF a -> RangeExprF b)
-> (forall a b. a -> RangeExprF b -> RangeExprF a)
-> Functor RangeExprF
forall a b. a -> RangeExprF b -> RangeExprF a
forall a b. (a -> b) -> RangeExprF a -> RangeExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RangeExprF a -> RangeExprF b
fmap :: forall a b. (a -> b) -> RangeExprF a -> RangeExprF b
$c<$ :: forall a b. a -> RangeExprF b -> RangeExprF a
<$ :: forall a b. a -> RangeExprF b -> RangeExprF a
Functor)
instance Eq1 RangeExprF where
liftEq :: forall a b.
(a -> b -> Bool) -> RangeExprF a -> RangeExprF b -> Bool
liftEq a -> b -> Bool
eq (Invert a
a) (Invert b
b) = a -> b -> Bool
eq a
a b
b
liftEq a -> b -> Bool
eq (Union a
a a
c) (Union b
b b
d) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
c b
d
liftEq a -> b -> Bool
eq (Intersection a
a a
c) (Intersection b
b b
d) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
c b
d
liftEq a -> b -> Bool
eq (Difference a
a a
c) (Difference b
b b
d) = a -> b -> Bool
eq a
a b
b Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
c b
d
liftEq a -> b -> Bool
_ RangeExprF a
_ RangeExprF b
_ = Bool
False
instance Show1 RangeExprF where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> RangeExprF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showPrec [a] -> ShowS
_ Int
p =
\case
Invert a
x -> String -> ShowS
showString String
"not " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True (Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x)
Union a
a a
b ->
Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" \\/ "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
b
Intersection a
a a
b ->
Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" /\\ "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
b
Difference a
a a
b ->
Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" - "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
b
newtype RangeExpr a = RangeExpr {forall a. RangeExpr a -> Free RangeExprF a
getFree :: Free RangeExprF a}
deriving (Int -> RangeExpr a -> ShowS
[RangeExpr a] -> ShowS
RangeExpr a -> String
(Int -> RangeExpr a -> ShowS)
-> (RangeExpr a -> String)
-> ([RangeExpr a] -> ShowS)
-> Show (RangeExpr a)
forall a. Show a => Int -> RangeExpr a -> ShowS
forall a. Show a => [RangeExpr a] -> ShowS
forall a. Show a => RangeExpr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RangeExpr a -> ShowS
showsPrec :: Int -> RangeExpr a -> ShowS
$cshow :: forall a. Show a => RangeExpr a -> String
show :: RangeExpr a -> String
$cshowList :: forall a. Show a => [RangeExpr a] -> ShowS
showList :: [RangeExpr a] -> ShowS
Show, RangeExpr a -> RangeExpr a -> Bool
(RangeExpr a -> RangeExpr a -> Bool)
-> (RangeExpr a -> RangeExpr a -> Bool) -> Eq (RangeExpr a)
forall a. Eq a => RangeExpr a -> RangeExpr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RangeExpr a -> RangeExpr a -> Bool
== :: RangeExpr a -> RangeExpr a -> Bool
$c/= :: forall a. Eq a => RangeExpr a -> RangeExpr a -> Bool
/= :: RangeExpr a -> RangeExpr a -> Bool
Eq, (forall a b. (a -> b) -> RangeExpr a -> RangeExpr b)
-> (forall a b. a -> RangeExpr b -> RangeExpr a)
-> Functor RangeExpr
forall a b. a -> RangeExpr b -> RangeExpr a
forall a b. (a -> b) -> RangeExpr a -> RangeExpr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RangeExpr a -> RangeExpr b
fmap :: forall a b. (a -> b) -> RangeExpr a -> RangeExpr b
$c<$ :: forall a b. a -> RangeExpr b -> RangeExpr a
<$ :: forall a b. a -> RangeExpr b -> RangeExpr a
Functor)
type Algebra f a = f a -> a
rangeMergeAlgebra :: (Ord a) => Algebra RangeExprF (RangeMerge a)
rangeMergeAlgebra :: forall a. Ord a => Algebra RangeExprF (RangeMerge a)
rangeMergeAlgebra =
\case
Invert RangeMerge a
a -> RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a
invertRM RangeMerge a
a
Union RangeMerge a
a RangeMerge a
b -> RangeMerge a
a RangeMerge a -> RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
`unionRangeMerges` RangeMerge a
b
Intersection RangeMerge a
a RangeMerge a
b -> RangeMerge a
a RangeMerge a -> RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
`intersectionRangeMerges` RangeMerge a
b
Difference RangeMerge a
a RangeMerge a
b -> RangeMerge a
a RangeMerge a -> RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a -> RangeMerge a
`intersectionRangeMerges` RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a
invertRM RangeMerge a
b