{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Range.Algebra.Internal where

import Prelude hiding (const)

import Data.Range.RangeInternal

import Control.Monad.Free
import Data.Functor.Classes

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 (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)
  liftShowsPrec Int -> a -> ShowS
showPrec [a] -> ShowS
_ Int
p (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
  liftShowsPrec Int -> a -> ShowS
showPrec [a] -> ShowS
_ Int
p (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
  liftShowsPrec Int -> a -> ShowS
showPrec [a] -> ShowS
_ Int
p (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

-- | An expression tree representing a sequence of set operations on ranges.
-- Construct trees with 'Data.Range.Algebra.const', 'Data.Range.Algebra.union',
-- 'Data.Range.Algebra.intersection', 'Data.Range.Algebra.difference', and
-- 'Data.Range.Algebra.invert', then collapse the tree with 'Data.Range.Algebra.eval'.
--
-- The type parameter @a@ is the range representation the tree will eventually
-- evaluate to (e.g. @['Data.Range.Range' Integer]@ or @Integer -> 'Bool'@).
--
-- @RangeExpr@ is a 'Functor', so you can map over the leaf values before evaluation.
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)

-- | The type of an evaluation function for a 'RangeExpr'. You will not normally
-- need to reference this alias directly; it exists to express the signature of
-- 'Data.Range.Algebra.eval'.
--
-- Concretely, @Algebra f a = f a -> a@, meaning: given a functor @f@ applied to
-- an already-evaluated @a@, produce the final @a@. The 'Control.Monad.Free.iter'
-- function from the @free@ package drives the bottom-up fold.
type Algebra f a = f a -> a

rangeMergeAlgebra :: (Ord a) => Algebra RangeExprF (RangeMerge a)
rangeMergeAlgebra :: forall a. Ord a => Algebra RangeExprF (RangeMerge a)
rangeMergeAlgebra (Invert RangeMerge a
a) = RangeMerge a -> RangeMerge a
forall a. Ord a => RangeMerge a -> RangeMerge a
invertRM RangeMerge a
a
rangeMergeAlgebra (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
rangeMergeAlgebra (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
rangeMergeAlgebra (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