{-# LANGUAGE OverloadedStrings #-}

-- | 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 (quote)
import Witch (into)

-- | 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 => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String forall a b. (a -> b) -> a -> b
$
          [Text] -> Text
T.unwords
            [ 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 => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
T.unwords [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