{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Language.REST.Internal.PartialOrder (
empty
, insert
, replaceUnsafe
, insertUnsafe
, gt
, toList
, isEmpty
, elems
, unionDisjointUnsafe
, PartialOrder
, toDescsList
, descendents
) where
import GHC.Generics (Generic)
import Data.Hashable
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.List as L
import Language.REST.Types ()
import Language.REST.Internal.Orphans ()
import Text.Printf
newtype PartialOrder a =
PartialOrder (M.Map a (S.Set a))
deriving (Eq (PartialOrder a)
Eq (PartialOrder a) =>
(PartialOrder a -> PartialOrder a -> Ordering)
-> (PartialOrder a -> PartialOrder a -> Bool)
-> (PartialOrder a -> PartialOrder a -> Bool)
-> (PartialOrder a -> PartialOrder a -> Bool)
-> (PartialOrder a -> PartialOrder a -> Bool)
-> (PartialOrder a -> PartialOrder a -> PartialOrder a)
-> (PartialOrder a -> PartialOrder a -> PartialOrder a)
-> Ord (PartialOrder a)
PartialOrder a -> PartialOrder a -> Bool
PartialOrder a -> PartialOrder a -> Ordering
PartialOrder a -> PartialOrder a -> PartialOrder a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PartialOrder a)
forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
forall a. Ord a => PartialOrder a -> PartialOrder a -> Ordering
forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
$ccompare :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Ordering
compare :: PartialOrder a -> PartialOrder a -> Ordering
$c< :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
< :: PartialOrder a -> PartialOrder a -> Bool
$c<= :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
<= :: PartialOrder a -> PartialOrder a -> Bool
$c> :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
> :: PartialOrder a -> PartialOrder a -> Bool
$c>= :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
>= :: PartialOrder a -> PartialOrder a -> Bool
$cmax :: forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
max :: PartialOrder a -> PartialOrder a -> PartialOrder a
$cmin :: forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
min :: PartialOrder a -> PartialOrder a -> PartialOrder a
Ord, PartialOrder a -> PartialOrder a -> Bool
(PartialOrder a -> PartialOrder a -> Bool)
-> (PartialOrder a -> PartialOrder a -> Bool)
-> Eq (PartialOrder a)
forall a. Eq a => PartialOrder a -> PartialOrder a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PartialOrder a -> PartialOrder a -> Bool
== :: PartialOrder a -> PartialOrder a -> Bool
$c/= :: forall a. Eq a => PartialOrder a -> PartialOrder a -> Bool
/= :: PartialOrder a -> PartialOrder a -> Bool
Eq, (forall x. PartialOrder a -> Rep (PartialOrder a) x)
-> (forall x. Rep (PartialOrder a) x -> PartialOrder a)
-> Generic (PartialOrder a)
forall x. Rep (PartialOrder a) x -> PartialOrder a
forall x. PartialOrder a -> Rep (PartialOrder a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PartialOrder a) x -> PartialOrder a
forall a x. PartialOrder a -> Rep (PartialOrder a) x
$cfrom :: forall a x. PartialOrder a -> Rep (PartialOrder a) x
from :: forall x. PartialOrder a -> Rep (PartialOrder a) x
$cto :: forall a x. Rep (PartialOrder a) x -> PartialOrder a
to :: forall x. Rep (PartialOrder a) x -> PartialOrder a
Generic, Eq (PartialOrder a)
Eq (PartialOrder a) =>
(Int -> PartialOrder a -> Int)
-> (PartialOrder a -> Int) -> Hashable (PartialOrder a)
Int -> PartialOrder a -> Int
PartialOrder a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (PartialOrder a)
forall a. Hashable a => Int -> PartialOrder a -> Int
forall a. Hashable a => PartialOrder a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> PartialOrder a -> Int
hashWithSalt :: Int -> PartialOrder a -> Int
$chash :: forall a. Hashable a => PartialOrder a -> Int
hash :: PartialOrder a -> Int
Hashable)
instance (Show a) => Show (PartialOrder a) where
show :: PartialOrder a -> String
show (PartialOrder Map a (Set a)
m) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
" ∧ " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((a, Set a) -> String) -> [(a, Set a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, Set a) -> String
forall {a} {a} {t}.
(Show a, Show a, PrintfType t) =>
(a, Set a) -> t
go (Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
M.toList Map a (Set a)
m) where
go :: (a, Set a) -> t
go (a
key, Set a
s) = case Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
s of
[a
x] -> String -> String -> String -> t
forall r. PrintfType r => String -> r
printf String
"%s > %s" (a -> String
forall a. Show a => a -> String
show a
key) (a -> String
forall a. Show a => a -> String
show a
x)
[a]
xs -> String -> String -> String -> t
forall r. PrintfType r => String -> r
printf String
"%s > { %s }" (a -> String
forall a. Show a => a -> String
show a
key) (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
xs))
empty :: PartialOrder a
empty :: forall a. PartialOrder a
empty = Map a (Set a) -> PartialOrder a
forall a. Map a (Set a) -> PartialOrder a
PartialOrder Map a (Set a)
forall k a. Map k a
M.empty
isEmpty :: Eq a => PartialOrder a -> Bool
isEmpty :: forall a. Eq a => PartialOrder a -> Bool
isEmpty PartialOrder a
p = PartialOrder a
p PartialOrder a -> PartialOrder a -> Bool
forall a. Eq a => a -> a -> Bool
== PartialOrder a
forall a. PartialOrder a
empty
canInsert :: (Eq a, Ord a, Hashable a) => PartialOrder a -> a -> a -> Bool
canInsert :: forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
canInsert PartialOrder a
o a
f a
g = a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
g Bool -> Bool -> Bool
&& Bool -> Bool
not (PartialOrder a -> a -> a -> Bool
forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
gt PartialOrder a
o a
f a
g) Bool -> Bool -> Bool
&& Bool -> Bool
not (PartialOrder a -> a -> a -> Bool
forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
gt PartialOrder a
o a
g a
f)
gt :: (Eq a, Ord a, Hashable a) => PartialOrder a -> a -> a -> Bool
gt :: forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
gt PartialOrder a
po a
t a
u = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
u (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ a -> PartialOrder a -> Set a
forall a. Ord a => a -> PartialOrder a -> Set a
descendents a
t PartialOrder a
po
unionDisjointUnsafe :: Ord a => PartialOrder a -> PartialOrder a -> PartialOrder a
unionDisjointUnsafe :: forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
unionDisjointUnsafe (PartialOrder Map a (Set a)
m) (PartialOrder Map a (Set a)
m') = Map a (Set a) -> PartialOrder a
forall a. Map a (Set a) -> PartialOrder a
PartialOrder (Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map a (Set a)
m Map a (Set a)
m')
ascendants :: Ord k => k -> PartialOrder k -> S.Set k
ascendants :: forall a. Ord a => a -> PartialOrder a -> Set a
ascendants k
k (PartialOrder Map k (Set k)
m) = Map k (Set k) -> Set k
forall k a. Map k a -> Set k
M.keysSet (Map k (Set k) -> Set k) -> Map k (Set k) -> Set k
forall a b. (a -> b) -> a -> b
$ (Set k -> Bool) -> Map k (Set k) -> Map k (Set k)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member k
k) Map k (Set k)
m
descendents :: Ord a => a -> PartialOrder a -> S.Set a
descendents :: forall a. Ord a => a -> PartialOrder a -> Set a
descendents a
k (PartialOrder Map a (Set a)
m) = Set a -> a -> Map a (Set a) -> Set a
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Set a
forall a. Set a
S.empty a
k Map a (Set a)
m
{-# INLINE insertUnsafe #-}
insertUnsafe :: Ord a => PartialOrder a -> a -> a -> PartialOrder a
insertUnsafe :: forall a. Ord a => PartialOrder a -> a -> a -> PartialOrder a
insertUnsafe o :: PartialOrder a
o@(PartialOrder Map a (Set a)
m) a
f a
g = PartialOrder a
result
where
result :: PartialOrder a
result = Map a (Set a) -> PartialOrder a
forall a. Map a (Set a) -> PartialOrder a
PartialOrder (Map a (Set a) -> PartialOrder a)
-> Map a (Set a) -> PartialOrder a
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a)
-> a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union a
f Set a
decs (Map a (Set a) -> Map a (Set a)) -> Map a (Set a) -> Map a (Set a)
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey a -> Set a -> Set a
go Map a (Set a)
m
go :: a -> Set a -> Set a
go a
k Set a
old | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
k Set a
ascs = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
old Set a
decs
go a
_ Set a
v = Set a
v
ascs :: Set a
ascs = a -> PartialOrder a -> Set a
forall a. Ord a => a -> PartialOrder a -> Set a
ascendants a
f PartialOrder a
o
decs :: Set a
decs = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
g (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ a -> PartialOrder a -> Set a
forall a. Ord a => a -> PartialOrder a -> Set a
descendents a
g PartialOrder a
o
{-# INLINE insert #-}
insert :: (Eq a, Ord a, Hashable a) => PartialOrder a -> a -> a -> Maybe (PartialOrder a)
insert :: forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Maybe (PartialOrder a)
insert PartialOrder a
o a
f a
g = if PartialOrder a -> a -> a -> Bool
forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
canInsert PartialOrder a
o a
f a
g then PartialOrder a -> Maybe (PartialOrder a)
forall a. a -> Maybe a
Just (PartialOrder a -> a -> a -> PartialOrder a
forall a. Ord a => PartialOrder a -> a -> a -> PartialOrder a
insertUnsafe PartialOrder a
o a
f a
g) else Maybe (PartialOrder a)
forall a. Maybe a
Nothing
toDescsList :: PartialOrder k -> [(k, S.Set k)]
toDescsList :: forall k. PartialOrder k -> [(k, Set k)]
toDescsList (PartialOrder Map k (Set k)
m) = Map k (Set k) -> [(k, Set k)]
forall k a. Map k a -> [(k, a)]
M.toList Map k (Set k)
m
toList :: PartialOrder a -> [(a, a)]
toList :: forall a. PartialOrder a -> [(a, a)]
toList (PartialOrder Map a (Set a)
m) = do
(a
k, Set a
vs) <- Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
M.toList Map a (Set a)
m
a
v <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
vs
(a, a) -> [(a, a)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
k, a
v)
elems :: (Eq a, Ord a, Hashable a) => PartialOrder a -> S.Set a
elems :: forall a. (Eq a, Ord a, Hashable a) => PartialOrder a -> Set a
elems (PartialOrder Map a (Set a)
m) = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union (Map a (Set a) -> Set a
forall k a. Map k a -> Set k
M.keysSet Map a (Set a)
m) ([Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (Map a (Set a) -> [Set a]
forall k a. Map k a -> [a]
M.elems Map a (Set a)
m))
replaceUnsafe :: (Eq a, Ord a, Hashable a) => [a] -> a -> PartialOrder a -> PartialOrder a
replaceUnsafe :: forall a.
(Eq a, Ord a, Hashable a) =>
[a] -> a -> PartialOrder a -> PartialOrder a
replaceUnsafe [a]
froms a
to po :: PartialOrder a
po@(PartialOrder Map a (Set a)
m) = PartialOrder a
result where
from' :: Set a
from' = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
froms
descs :: Set a
descs = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((a -> Set a) -> [a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> PartialOrder a -> Set a
forall a. Ord a => a -> PartialOrder a -> Set a
`descendents` PartialOrder a
po) [a]
froms)
filtered :: Map a (Set a)
filtered = (a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\a
k Set a
_ -> a
k a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
froms) Map a (Set a)
m
m' :: Map a (Set a)
m' =
if Set a -> Bool
forall a. Set a -> Bool
S.null Set a
descs
then Map a (Set a)
filtered
else (Set a -> Set a -> Set a)
-> a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union a
to Set a
descs Map a (Set a)
filtered
result :: PartialOrder a
result = Map a (Set a) -> PartialOrder a
forall a. Map a (Set a) -> PartialOrder a
PartialOrder (Map a (Set a) -> PartialOrder a)
-> Map a (Set a) -> PartialOrder a
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Set a -> Set a
go Map a (Set a)
m'
go :: Set a -> Set a
go Set a
s | Set a -> Bool
hasFrom Set a
s = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
to (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
descs (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set a
s Set a
from'
go Set a
s = Set a
s
hasFrom :: Set a -> Bool
hasFrom Set a
set = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
set) [a]
froms