{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Internal.Graph ( cycleChecking, Node, Graph, Edges, ) where import Data.List (lookup) import Data.Morpheus.Types.Internal.AST (Ref (..)) import Relude type Node = Ref type Edges name = (Ref name, [Ref name]) type Graph name = [Edges name] cycleChecking :: (Eq name, Monad m) => (NonEmpty (Ref name) -> m ()) -> Graph name -> m () cycleChecking :: forall name (m :: * -> *). (Eq name, Monad m) => (NonEmpty (Ref name) -> m ()) -> Graph name -> m () cycleChecking NonEmpty (Ref name) -> m () fail' Graph name graph = forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ (Ref name, [Ref name]) -> m () checkNode Graph name graph where checkNode :: (Ref name, [Ref name]) -> m () checkNode (Ref name node, [Ref name] _) = forall name (m :: * -> *). (Eq name, Monad m) => Graph name -> Ref name -> [Ref name] -> (NonEmpty (Ref name) -> m ()) -> m () cycleCheckingWith Graph name graph Ref name node [Ref name node] NonEmpty (Ref name) -> m () fail' cycleCheckingWith :: (Eq name, Monad m) => Graph name -> Ref name -> [Ref name] -> (NonEmpty (Ref name) -> m ()) -> m () cycleCheckingWith :: forall name (m :: * -> *). (Eq name, Monad m) => Graph name -> Ref name -> [Ref name] -> (NonEmpty (Ref name) -> m ()) -> m () cycleCheckingWith Graph name graph Ref name parentNode [Ref name] history NonEmpty (Ref name) -> m () fail' = forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ (forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Ref name parentNode Graph name graph) (forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ Ref name -> m () checkNode) where checkNode :: Ref name -> m () checkNode Ref name node | Ref name node forall (f :: * -> *) a. (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool `elem` [Ref name] history = NonEmpty (Ref name) -> m () fail' (Ref name node forall a. a -> [a] -> NonEmpty a :| [Ref name] history) | Bool otherwise = forall name (m :: * -> *). (Eq name, Monad m) => Graph name -> Ref name -> [Ref name] -> (NonEmpty (Ref name) -> m ()) -> m () cycleCheckingWith Graph name graph Ref name node ([Ref name] history forall a. Semigroup a => a -> a -> a <> [Ref name node]) NonEmpty (Ref name) -> m () fail'