{-# 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)

-- | This is an F-Algebra. You don't need to know what this is in order to be able
-- to use this module, but, if you are interested you can
-- <https://www.schoolofhaskell.com/user/bartosz/understanding-algebras read more on School of Haskell>.
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