{-# 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'