{-# 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 (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
min :: PartialOrder a -> PartialOrder a -> PartialOrder a
$cmin :: forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
max :: PartialOrder a -> PartialOrder a -> PartialOrder a
$cmax :: forall a.
Ord a =>
PartialOrder a -> PartialOrder a -> PartialOrder a
>= :: 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
$c< :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Bool
compare :: PartialOrder a -> PartialOrder a -> Ordering
$ccompare :: forall a. Ord a => PartialOrder a -> PartialOrder a -> Ordering
Ord, PartialOrder a -> PartialOrder a -> Bool
forall a. Eq a => PartialOrder a -> PartialOrder a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialOrder a -> PartialOrder a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (PartialOrder a) x -> PartialOrder a
$cfrom :: forall a x. PartialOrder a -> Rep (PartialOrder a) x
Generic, 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
hash :: PartialOrder a -> Int
$chash :: forall a. Hashable a => PartialOrder a -> Int
hashWithSalt :: Int -> PartialOrder a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> PartialOrder a -> Int
Hashable)
instance (Show a) => Show (PartialOrder a) where
show :: PartialOrder a -> String
show (PartialOrder Map a (Set a)
m) = forall a. [a] -> [[a]] -> [a]
L.intercalate String
" ∧ " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {t}.
(Show a, Show a, PrintfType t) =>
(a, Set a) -> t
go (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 forall a. Set a -> [a]
S.toList Set a
s of
[a
x] -> forall r. PrintfType r => String -> r
printf String
"%s > %s" (forall a. Show a => a -> String
show a
key) (forall a. Show a => a -> String
show a
x)
[a]
xs -> forall r. PrintfType r => String -> r
printf String
"%s > { %s }" (forall a. Show a => a -> String
show a
key) (forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [a]
xs))
empty :: PartialOrder a
empty :: forall a. PartialOrder a
empty = forall a. Map a (Set a) -> PartialOrder a
PartialOrder 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 forall a. Eq a => a -> a -> Bool
== 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 forall a. Eq a => a -> a -> Bool
/= a
g Bool -> Bool -> Bool
&& Bool -> Bool
not (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 (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 = forall a. Ord a => a -> Set a -> Bool
S.member a
u forall a b. (a -> b) -> a -> b
$ 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') = forall a. Map a (Set a) -> PartialOrder a
PartialOrder (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) = forall k a. Map k a -> Set k
M.keysSet forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (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) = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault 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 = forall a. Map a (Set a) -> PartialOrder a
PartialOrder forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Ord a => Set a -> Set a -> Set a
S.union a
f Set a
decs forall a b. (a -> b) -> a -> b
$ 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 | forall a. Ord a => a -> Set a -> Bool
S.member a
k Set a
ascs = 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 = forall a. Ord a => a -> PartialOrder a -> Set a
ascendants a
f PartialOrder a
o
decs :: Set a
decs = forall a. Ord a => a -> Set a -> Set a
S.insert a
g forall a b. (a -> b) -> a -> b
$ 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 forall a.
(Eq a, Ord a, Hashable a) =>
PartialOrder a -> a -> a -> Bool
canInsert PartialOrder a
o a
f a
g then forall a. a -> Maybe a
Just (forall a. Ord a => PartialOrder a -> a -> a -> PartialOrder a
insertUnsafe PartialOrder a
o a
f a
g) else 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) = 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) <- forall k a. Map k a -> [(k, a)]
M.toList Map a (Set a)
m
a
v <- forall a. Set a -> [a]
S.toList Set a
vs
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) = forall a. Ord a => Set a -> Set a -> Set a
S.union (forall k a. Map k a -> Set k
M.keysSet Map a (Set a)
m) (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (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' = forall a. Ord a => [a] -> Set a
S.fromList [a]
froms
descs :: Set a
descs = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => a -> PartialOrder a -> Set a
`descendents` PartialOrder a
po) [a]
froms)
filtered :: Map a (Set a)
filtered = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\a
k Set a
_ -> a
k 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 forall a. Set a -> Bool
S.null Set a
descs
then Map a (Set a)
filtered
else forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith 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 = forall a. Map a (Set a) -> PartialOrder a
PartialOrder forall a b. (a -> b) -> a -> b
$ 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 = forall a. Ord a => a -> Set a -> Set a
S.insert a
to forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
descs forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
set) [a]
froms