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