{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
module GraphRewriting.Layout.Gravitation where

import Data.View
import Data.Vector.Class
import Data.Vector.V2 ()
import Data.Functor ()
import GraphRewriting.Pattern ()
import GraphRewriting.Graph.Types
import GraphRewriting.Graph.Read
import GraphRewriting.Layout.Position
import GraphRewriting.Layout.Force


centralGravitation ∷ View Position n ⇒ Node → WithGraph n Force
centralGravitation :: forall n. View Position n => Node -> WithGraph n Force
centralGravitation = (n -> Force)
-> ReaderT (Graph n) Identity n -> ReaderT (Graph n) Identity Force
forall a b.
(a -> b)
-> ReaderT (Graph n) Identity a -> ReaderT (Graph n) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector2 -> Vector2 -> Force
attraction (Scalar -> Vector2
forall v. BasicVector v => Scalar -> v
vpromote Scalar
0) (Vector2 -> Force) -> (n -> Vector2) -> n -> Force
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position) (ReaderT (Graph n) Identity n -> ReaderT (Graph n) Identity Force)
-> (Node -> ReaderT (Graph n) Identity n)
-> Node
-> ReaderT (Graph n) Identity Force
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> ReaderT (Graph n) Identity n
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode

gravitation ∷ View Position n ⇒ Node -> Rewrite n Force
gravitation :: forall n. View Position n => Node -> Rewrite n Force
gravitation Node
node = do
 	Vector2
n ← (Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position (n -> Vector2) -> Rewrite n n -> Rewrite n Vector2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> Rewrite n n
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode Node
node
 	[Vector2]
ns ← ([n] -> [Vector2]) -> Rewrite n [n] -> Rewrite n [Vector2]
forall a b. (a -> b) -> Rewrite n a -> Rewrite n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((n -> Vector2) -> [n] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> Vector2) -> [n] -> [Vector2])
-> (n -> Vector2) -> [n] -> [Vector2]
forall a b. (a -> b) -> a -> b
$ (Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position) ((Node -> Rewrite n n) -> [Node] -> Rewrite n [n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> Rewrite n n
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode ([Node] -> Rewrite n [n]) -> Rewrite n [Node] -> Rewrite n [n]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Rewrite n [Node]
forall n (m :: * -> *). MonadReader (Graph n) m => m [Node]
readNodeList)
 	Force -> Rewrite n Force
forall a. a -> Rewrite n a
forall (m :: * -> *) a. Monad m => a -> m a
return (Force -> Rewrite n Force) -> Force -> Rewrite n Force
forall a b. (a -> b) -> a -> b
$ [Force] -> Force
fsum [Vector2 -> Vector2 -> Force
attraction Vector2
n' Vector2
n | Vector2
n' ← [Vector2]
ns]