{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Validity checking for 'Objective' prerequisites
module Swarm.Game.Scenario.Objective.Validation where

import Control.Monad (unless)
import Data.Foldable (for_, toList)
import Data.Graph (stronglyConnComp)
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
import Data.Text qualified as T
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Graph
import Swarm.Util (failT, quote)

-- | Performs monadic validation before returning
-- the "pure" construction of a wrapper record.
-- This validation entails:
--
-- 1. Ensuring that all goal references utilized in prerequisites
--    actually exist
-- 2. Ensuring that the graph of dependencies is acyclic.
validateObjectives ::
  MonadFail m =>
  [Objective] ->
  m [Objective]
validateObjectives :: forall (m :: * -> *). MonadFail m => [Objective] -> m [Objective]
validateObjectives [Objective]
objectives = do
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Objective]
objectives forall a b. (a -> b) -> a -> b
$ \Objective
x -> case Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite Objective
x of
    Just PrerequisiteConfig
p ->
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Text
remaining) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT
          [ Text
"Reference to undefined objective(s)"
          , Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Text
remaining) forall a. Semigroup a => a -> a -> a
<> Text
"."
          , Text
"Defined are:"
          , Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Text
allIds)
          ]
     where
      refs :: Set Text
refs = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ PrerequisiteConfig -> Prerequisite Text
logic PrerequisiteConfig
p
      remaining :: Set Text
remaining = forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Text
refs Set Text
allIds
    Maybe PrerequisiteConfig
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SCC Objective] -> Bool
isAcyclicGraph [SCC Objective]
connectedComponents) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"There are dependency cycles in the prerequisites."]

  forall (m :: * -> *) a. Monad m => a -> m a
return [Objective]
objectives
 where
  connectedComponents :: [SCC Objective]
connectedComponents = forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp forall a b. (a -> b) -> a -> b
$ [Objective] -> Edges
makeGraphEdges [Objective]
objectives
  allIds :: Set Text
allIds = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Objective -> Maybe Text
_objectiveId [Objective]
objectives