{-# LANGUAGE OverloadedStrings #-}

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

import Control.Lens (view, (^.))
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
  [Objective] -> (Objective -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Objective]
objectives ((Objective -> m ()) -> m ()) -> (Objective -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Objective
x -> case Objective
x Objective
-> Getting
     (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
-> Maybe PrerequisiteConfig
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
Lens' Objective (Maybe PrerequisiteConfig)
objectivePrerequisite of
    Just PrerequisiteConfig
p ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Text -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Text
remaining) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        [Text] -> m ()
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT
          [ Text
"Reference to undefined objective(s)"
          , Text -> [Text] -> Text
T.intercalate Text
", " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
remaining) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
          , Text
"Defined are:"
          , Text -> [Text] -> Text
T.intercalate Text
", " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
allIds)
          ]
     where
      refs :: Set Text
refs = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Prerequisite Text -> [Text]
forall a. Prerequisite a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Prerequisite Text -> [Text]) -> Prerequisite Text -> [Text]
forall a b. (a -> b) -> a -> b
$ PrerequisiteConfig -> Prerequisite Text
logic PrerequisiteConfig
p
      remaining :: Set Text
remaining = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Text
refs Set Text
allIds
    Maybe PrerequisiteConfig
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

  [Objective] -> m [Objective]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Objective]
objectives
 where
  connectedComponents :: [SCC Objective]
connectedComponents = [(Objective, ObjectiveId, [ObjectiveId])] -> [SCC Objective]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ([(Objective, ObjectiveId, [ObjectiveId])] -> [SCC Objective])
-> [(Objective, ObjectiveId, [ObjectiveId])] -> [SCC Objective]
forall a b. (a -> b) -> a -> b
$ [Objective] -> [(Objective, ObjectiveId, [ObjectiveId])]
makeGraphEdges [Objective]
objectives
  allIds :: Set Text
allIds = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (Objective -> Maybe Text) -> [Objective] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Getting (Maybe Text) Objective (Maybe Text)
-> Objective -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Text) Objective (Maybe Text)
Lens' Objective (Maybe Text)
objectiveId) [Objective]
objectives