{-# LANGUAGE OverloadedStrings #-}
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)
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