{-# 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 = (Ref, [Ref]) type Graph = [Edges] cycleChecking :: Applicative m => (NonEmpty Ref -> m ()) -> Graph -> m () cycleChecking :: (NonEmpty Ref -> m ()) -> Graph -> m () cycleChecking NonEmpty Ref -> m () fail' Graph graph = ((Ref, [Ref]) -> m ()) -> Graph -> m () forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ (Ref, [Ref]) -> m () checkNode Graph graph where checkNode :: (Ref, [Ref]) -> m () checkNode (Ref node, [Ref] _) = Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () forall (m :: * -> *). Applicative m => Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () cycleCheckingWith Graph graph Ref node [Ref node] NonEmpty Ref -> m () fail' cycleCheckingWith :: Applicative m => Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () cycleCheckingWith :: Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () cycleCheckingWith Graph graph Ref parentNode [Ref] history NonEmpty Ref -> m () fail' = case Ref -> Graph -> Maybe [Ref] forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup Ref parentNode Graph graph of Just [Ref] node -> (Ref -> m ()) -> [Ref] -> m () forall (t :: * -> *) (f :: * -> *) a b. (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ Ref -> m () checkNode [Ref] node Maybe [Ref] Nothing -> () -> m () forall (f :: * -> *) a. Applicative f => a -> f a pure () where checkNode :: Ref -> m () checkNode Ref node | Ref node Ref -> [Ref] -> Bool forall (f :: * -> *) a. (Foldable f, DisallowElem f, Eq a) => a -> f a -> Bool `elem` [Ref] history = NonEmpty Ref -> m () fail' (Ref node Ref -> [Ref] -> NonEmpty Ref forall a. a -> [a] -> NonEmpty a :| [Ref] history) | Bool otherwise = Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () forall (m :: * -> *). Applicative m => Graph -> Ref -> [Ref] -> (NonEmpty Ref -> m ()) -> m () cycleCheckingWith Graph graph Ref node ([Ref] history [Ref] -> [Ref] -> [Ref] forall a. Semigroup a => a -> a -> a <> [Ref node]) NonEmpty Ref -> m () fail'