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