{-# LANGUAGE CPP #-}
module Algebra.Graph.Internal (
List (..),
Focus (..), emptyFocus, vertexFocus, overlayFoci, connectFoci, foldr1Safe,
maybeF,
setProduct, setProductWith, forEach, forEachInt, coerce00, coerce10,
coerce20, coerce01, coerce11, coerce21
) where
import Data.Coerce
import Data.Foldable
import Data.Semigroup
import Data.IntSet (IntSet)
import Data.Set (Set)
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import qualified GHC.Exts as Exts
newtype List a = List (Endo [a]) deriving (Semigroup (List a)
List a
Semigroup (List a)
-> List a
-> (List a -> List a -> List a)
-> ([List a] -> List a)
-> Monoid (List a)
[List a] -> List a
List a -> List a -> List a
forall a. Semigroup (List a)
forall a. List a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [List a] -> List a
forall a. List a -> List a -> List a
mconcat :: [List a] -> List a
$cmconcat :: forall a. [List a] -> List a
mappend :: List a -> List a -> List a
$cmappend :: forall a. List a -> List a -> List a
mempty :: List a
$cmempty :: forall a. List a
$cp1Monoid :: forall a. Semigroup (List a)
Monoid, b -> List a -> List a
NonEmpty (List a) -> List a
List a -> List a -> List a
(List a -> List a -> List a)
-> (NonEmpty (List a) -> List a)
-> (forall b. Integral b => b -> List a -> List a)
-> Semigroup (List a)
forall b. Integral b => b -> List a -> List a
forall a. NonEmpty (List a) -> List a
forall a. List a -> List a -> List a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> List a -> List a
stimes :: b -> List a -> List a
$cstimes :: forall a b. Integral b => b -> List a -> List a
sconcat :: NonEmpty (List a) -> List a
$csconcat :: forall a. NonEmpty (List a) -> List a
<> :: List a -> List a -> List a
$c<> :: forall a. List a -> List a -> List a
Semigroup)
instance Show a => Show (List a) where
show :: List a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (List a -> [a]) -> List a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Eq a => Eq (List a) where
List a
x == :: List a -> List a -> Bool
== List a
y = List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
y
instance Ord a => Ord (List a) where
compare :: List a -> List a -> Ordering
compare List a
x List a
y = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
x) (List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
y)
instance Exts.IsList (List a) where
type Item (List a) = a
fromList :: [Item (List a)] -> List a
fromList = Endo [a] -> List a
forall a. Endo [a] -> List a
List (Endo [a] -> List a) -> ([a] -> Endo [a]) -> [a] -> List a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (([a] -> [a]) -> Endo [a])
-> ([a] -> [a] -> [a]) -> [a] -> Endo [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
(<>)
toList :: List a -> [Item (List a)]
toList (List Endo [a]
x) = Endo [a] -> [a] -> [a]
forall a. Endo a -> a -> a
appEndo Endo [a]
x []
instance Foldable List where
foldMap :: (a -> m) -> List a -> m
foldMap a -> m
f = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> (List a -> [a]) -> List a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List a -> [a]
forall l. IsList l => l -> [Item l]
Exts.toList
toList :: List a -> [a]
toList = List a -> [a]
forall l. IsList l => l -> [Item l]
Exts.toList
instance Functor List where
fmap :: (a -> b) -> List a -> List b
fmap a -> b
f = [b] -> List b
forall l. IsList l => [Item l] -> l
Exts.fromList ([b] -> List b) -> (List a -> [b]) -> List a -> List b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> [b]) -> (List a -> [a]) -> List a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Applicative List where
pure :: a -> List a
pure = Endo [a] -> List a
forall a. Endo [a] -> List a
List (Endo [a] -> List a) -> (a -> Endo [a]) -> a -> List a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (([a] -> [a]) -> Endo [a]) -> (a -> [a] -> [a]) -> a -> Endo [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
List (a -> b)
f <*> :: List (a -> b) -> List a -> List b
<*> List a
x = [Item (List b)] -> List b
forall l. IsList l => [Item l] -> l
Exts.fromList (List (a -> b) -> [a -> b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List (a -> b)
f [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
x)
instance Monad List where
return :: a -> List a
return = a -> List a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
List a
x >>= :: List a -> (a -> List b) -> List b
>>= a -> List b
f = [Item (List b)] -> List b
forall l. IsList l => [Item l] -> l
Exts.fromList (List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
x [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= List b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List b -> [b]) -> (a -> List b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> List b
f)
data Focus a = Focus
{ Focus a -> Bool
ok :: Bool
, Focus a -> List a
is :: List a
, Focus a -> List a
os :: List a
, Focus a -> List a
vs :: List a }
emptyFocus :: Focus a
emptyFocus :: Focus a
emptyFocus = Bool -> List a -> List a -> List a -> Focus a
forall a. Bool -> List a -> List a -> List a -> Focus a
Focus Bool
False List a
forall a. Monoid a => a
mempty List a
forall a. Monoid a => a
mempty List a
forall a. Monoid a => a
mempty
vertexFocus :: (a -> Bool) -> a -> Focus a
vertexFocus :: (a -> Bool) -> a -> Focus a
vertexFocus a -> Bool
f a
x = Bool -> List a -> List a -> List a -> Focus a
forall a. Bool -> List a -> List a -> List a -> Focus a
Focus (a -> Bool
f a
x) List a
forall a. Monoid a => a
mempty List a
forall a. Monoid a => a
mempty (a -> List a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
overlayFoci :: Focus a -> Focus a -> Focus a
overlayFoci :: Focus a -> Focus a -> Focus a
overlayFoci Focus a
x Focus a
y = Bool -> List a -> List a -> List a -> Focus a
forall a. Bool -> List a -> List a -> List a -> Focus a
Focus (Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
x Bool -> Bool -> Bool
|| Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
y) (Focus a -> List a
forall a. Focus a -> List a
is Focus a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus a -> List a
forall a. Focus a -> List a
is Focus a
y) (Focus a -> List a
forall a. Focus a -> List a
os Focus a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus a -> List a
forall a. Focus a -> List a
os Focus a
y) (Focus a -> List a
forall a. Focus a -> List a
vs Focus a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus a -> List a
forall a. Focus a -> List a
vs Focus a
y)
connectFoci :: Focus a -> Focus a -> Focus a
connectFoci :: Focus a -> Focus a -> Focus a
connectFoci Focus a
x Focus a
y = Bool -> List a -> List a -> List a -> Focus a
forall a. Bool -> List a -> List a -> List a -> Focus a
Focus (Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
x Bool -> Bool -> Bool
|| Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
y) (List a
xs List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus a -> List a
forall a. Focus a -> List a
is Focus a
y) (Focus a -> List a
forall a. Focus a -> List a
os Focus a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> List a
ys) (Focus a -> List a
forall a. Focus a -> List a
vs Focus a
x List a -> List a -> List a
forall a. Semigroup a => a -> a -> a
<> Focus a -> List a
forall a. Focus a -> List a
vs Focus a
y)
where
xs :: List a
xs = if Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
y then Focus a -> List a
forall a. Focus a -> List a
vs Focus a
x else Focus a -> List a
forall a. Focus a -> List a
is Focus a
x
ys :: List a
ys = if Focus a -> Bool
forall a. Focus a -> Bool
ok Focus a
x then Focus a -> List a
forall a. Focus a -> List a
vs Focus a
y else Focus a -> List a
forall a. Focus a -> List a
os Focus a
y
foldr1Safe :: (a -> a -> a) -> [a] -> Maybe a
foldr1Safe :: (a -> a -> a) -> [a] -> Maybe a
foldr1Safe a -> a -> a
f = (a -> Maybe a -> Maybe a) -> Maybe a -> [a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> a) -> a -> Maybe a -> Maybe a
forall a b. (a -> b -> a) -> a -> Maybe b -> Maybe a
maybeF a -> a -> a
f) Maybe a
forall a. Maybe a
Nothing
{-# INLINE foldr1Safe #-}
maybeF :: (a -> b -> a) -> a -> Maybe b -> Maybe a
maybeF :: (a -> b -> a) -> a -> Maybe b -> Maybe a
maybeF a -> b -> a
f a
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Maybe b -> a) -> Maybe b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b -> a) -> Maybe b -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a -> b -> a
f a
x)
{-# INLINE maybeF #-}
setProduct :: Set a -> Set b -> Set (a, b)
#if MIN_VERSION_containers(0,5,11)
setProduct :: Set a -> Set b -> Set (a, b)
setProduct = Set a -> Set b -> Set (a, b)
forall a b. Set a -> Set b -> Set (a, b)
Set.cartesianProduct
#else
setProduct x y = Set.fromDistinctAscList [ (a, b) | a <- Set.toAscList x, b <- Set.toAscList y ]
#endif
setProductWith :: Ord c => (a -> b -> c) -> Set a -> Set b -> Set c
setProductWith :: (a -> b -> c) -> Set a -> Set b -> Set c
setProductWith a -> b -> c
f Set a
x Set b
y = [c] -> Set c
forall a. Ord a => [a] -> Set a
Set.fromList [ a -> b -> c
f a
a b
b | a
a <- Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
x, b
b <- Set b -> [b]
forall a. Set a -> [a]
Set.toAscList Set b
y ]
forEach :: Applicative f => Set a -> (a -> f b) -> f ()
forEach :: Set a -> (a -> f b) -> f ()
forEach Set a
s a -> f b
f = (a -> f () -> f ()) -> f () -> Set a -> f ()
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\a
a f ()
u -> a -> f b
f a
a f b -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
u) (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Set a
s
forEachInt :: Applicative f => IntSet -> (Int -> f a) -> f ()
forEachInt :: IntSet -> (Int -> f a) -> f ()
forEachInt IntSet
s Int -> f a
f = (Int -> f () -> f ()) -> f () -> IntSet -> f ()
forall b. (Int -> b -> b) -> b -> IntSet -> b
IntSet.foldr (\Int
a f ()
u -> Int -> f a
f Int
a f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
u) (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) IntSet
s
coerce00 :: Coercible f g => f x -> g x
coerce00 :: f x -> g x
coerce00 = f x -> g x
coerce
coerce10 :: (Coercible a b, Coercible f g) => (a -> f x) -> (b -> g x)
coerce10 :: (a -> f x) -> b -> g x
coerce10 = (a -> f x) -> b -> g x
coerce
coerce20 :: (Coercible a b, Coercible c d, Coercible f g)
=> (a -> c -> f x) -> (b -> d -> g x)
coerce20 :: (a -> c -> f x) -> b -> d -> g x
coerce20 = (a -> c -> f x) -> b -> d -> g x
coerce
coerce01 :: (Coercible a b, Coercible f g) => (f x -> a) -> (g x -> b)
coerce01 :: (f x -> a) -> g x -> b
coerce01 = (f x -> a) -> g x -> b
coerce
coerce11 :: (Coercible a b, Coercible c d, Coercible f g)
=> (a -> f x -> c) -> (b -> g x -> d)
coerce11 :: (a -> f x -> c) -> b -> g x -> d
coerce11 = (a -> f x -> c) -> b -> g x -> d
coerce
coerce21 :: (Coercible a b, Coercible c d, Coercible p q, Coercible f g)
=> (a -> c -> f x -> p) -> (b -> d -> g x -> q)
coerce21 :: (a -> c -> f x -> p) -> b -> d -> g x -> q
coerce21 = (a -> c -> f x -> p) -> b -> d -> g x -> q
coerce