{-# 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 (forM_, unless)
import Data.Foldable (for_, toList)
import Data.Maybe (fromMaybe, 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)
import Swarm.Util.Graph

-- | 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 -> Maybe PrerequisiteConfig -> (PrerequisiteConfig -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (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) ((PrerequisiteConfig -> m ()) -> m ())
-> (PrerequisiteConfig -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PrerequisiteConfig
p ->
    let 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
     in 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)
            ]

  (Text -> m ()) -> (() -> m ()) -> Either Text () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> (Text -> String) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m ()) -> Either Text () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text
-> (Objective -> Text)
-> [(Objective, ObjectiveId, [ObjectiveId])]
-> Either Text ()
forall key a.
Ord key =>
Text -> (a -> Text) -> [(a, key, [key])] -> Either Text ()
failOnCyclicGraph Text
"Prerequisites" (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"N/A" (Maybe Text -> Text)
-> (Objective -> Maybe Text) -> Objective -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, ObjectiveId, [ObjectiveId])]
edges

  [Objective] -> m [Objective]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Objective]
objectives
 where
  edges :: [(Objective, ObjectiveId, [ObjectiveId])]
edges = [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